annotate src/mule-ccl.c @ 617:af57a77cbc92

[xemacs-hg @ 2001-06-18 07:09:50 by ben] --------------------------------------------------------------- DOCUMENTATION FIXES: --------------------------------------------------------------- eval.c: Correct documentation. elhash.c: Doc correction. --------------------------------------------------------------- LISP OBJECT CLEANUP: --------------------------------------------------------------- bytecode.h, buffer.h, casetab.h, chartab.h, console-msw.h, console.h, database.c, device.h, eldap.h, elhash.h, events.h, extents.h, faces.h, file-coding.h, frame.h, glyphs.h, gui-x.h, gui.h, keymap.h, lisp-disunion.h, lisp-union.h, lisp.h, lrecord.h, lstream.h, mule-charset.h, objects.h, opaque.h, postgresql.h, process.h, rangetab.h, specifier.h, toolbar.h, tooltalk.h, ui-gtk.h: Add wrap_* to all objects (it was already there for a few of them) -- an expression to encapsulate a pointer into a Lisp object, rather than the inconvenient XSET*. "wrap" was chosen because "make" as in make_int(), make_char() is not appropriate. (It implies allocation. The issue does not exist for ints and chars because they are not allocated.) Full error checking has been added to these expressions. When used without error checking, non-union build, use of these expressions will incur no loss of efficiency. (In fact, XSET* is now defined in terms of wrap_* in a non-union build.) In a union build, you will also get no loss of efficiency provided that you have a decent optimizing compiler, and a compiler that either understands inlines or automatically inlines those particular functions. (And since people don't normally do their production builds on union, it doesn't matter.) Update the sample Lisp object definition in lrecord.h accordingly. dumper.c: Fix places in dumper that referenced wrap_object to reference its new name, wrap_pointer_1. buffer.c, bufslots.h, conslots.h, console.c, console.h, devslots.h, device.c, device.h, frame.c, frame.h, frameslots.h, window.c, window.h, winslots.h: -- Extract out the Lisp objects of `struct device' into devslots.h, just like for the other structures. -- Extract out the remaining (not copied into the window config) Lisp objects in `struct window' into winslots.h; use different macros (WINDOW_SLOT vs. WINDOW_SAVED_SLOT) to differentiate them. -- Eliminate the `dead' flag of `struct frame', since it duplicates information already available in `framemeths', and fix FRAME_LIVE_P accordingly. (Devices and consoles already work this way.) -- In *slots.h, switch to system where MARKED_SLOT is automatically undef'd at the end of the file. (Follows what winslots.h already does.) -- Update the comments at the beginning of *slots.h to be accurate. -- When making any of the above objects dead, zero it out entirely and reset all Lisp object slots to Qnil. (We were already doing this somewhat, but not consistently.) This (1) Eliminates the possibility of extra objects hanging around that ought to be GC'd, (2) Causes an immediate crash if anyone tries to access a structure in one of these objects, (3) Ensures consistent behavior wrt dead objects. dialog-msw.c: Use internal_object_printer, since this object should not escape. --------------------------------------------------------------- FIXING A CRASH THAT I HIT ONCE (AND A RELATED BAD BEHAVIOR): --------------------------------------------------------------- eval.c: Fix up some comments about the FSF implementation. Fix two nasty bugs: (1) condition_case_unwind frees the conses sitting in the catch->tag slot too quickly, resulting in a crash that I hit. (2) catches need to be unwound one at a time when calling unwind-protect code, rather than all at once at the end; otherwise, incorrect behavior can result. (A comment shows exactly how.) backtrace.h: Improve comment about FSF differences in the handler stack. --------------------------------------------------------------- FIXING A CRASH THAT I REPEATEDLY HIT WHEN USING THE MOUSE WHEEL UNDER MSWINDOWS: --------------------------------------------------------------- Basic idea: My crash is due either to a dead, non-marked, GC-collected frame inside of a window mirror, or a prematurely freed window mirror. We need to mark the Lisp objects inside of window mirrors. Tracking the lifespan of window mirrors and scrollbar instances is extremely hard, and there may well be lurking bugs where such objects are freed too soon. The only safe way to fix these problems (and it fixes both problems at once) is to make both of these structures Lisp objects. lrecord.h, emacs.c, inline.c, scrollbar-gtk.c, scrollbar-msw.c, scrollbar-x.c, scrollbar.c, scrollbar.h, symsinit.h: Make scrollbar instances actual Lisp objects. Mark the window mirrors in them. inline.c needs to know about scrollbar.h now. Record the new type in lrecord.h. Fix up scrollbar-*.c appropriately. Create a hash table in scrollbar-msw.c so that the scrollbar instances stored in scrollbar HWND's are properly GC-protected. Create complex_vars_of_scrollbar_mswindows() to create the hash table at startup, and call it from emacs.c. Don't store the scrollbar instance as a property of the GTK scrollbar, as it's not used and if we did this, we'd have to separately GC-protect it in a hash table, like in MS Windows. lrecord.h, frame.h, frame.c, frameslots.h, redisplay.c, window.c, window.h: Move mark_window_mirror from redisplay.c to window.c. Make window mirrors actual Lisp objects. Tell lrecord.h about them. Change the window mirror member of struct frame from a pointer to a Lisp object, and add XWINDOW_MIRROR in appropriate places. Mark the scrollbar instances in the window mirror. redisplay.c, redisplay.h, alloc.c: Delete mark_redisplay. Don't call mark_redisplay. We now mark frame-specific structures in mark_frame. NOTE: I also deleted an extremely questionable call to update_frame_window_mirrors(). It was extremely questionable before, and now totally impossible, since it will create Lisp objects during redisplay. frame.c: Mark the scrollbar instances, which are now Lisp objects. Call mark_gutter() here, not in mark_redisplay(). gutter.c: Update comments about correct marking. --------------------------------------------------------------- ISSUES BROUGHT UP BY MARTIN: --------------------------------------------------------------- buffer.h: Put back these macros the way Steve T and I think they ought to be. I already explained in a previous changelog entry why I think these macros should be the way I'd defined them. Once again: We fix these macros so they don't care about the type of their lvalues. The non-C-string equivalents of these already function in the same way, and it's correct because it should be OK to pass in a CBufbyte *, a BufByte *, a Char_Binary *, an UChar_Binary *, etc. The whole reason for these different types is to work around errors caused by signed-vs-unsigned non-matching types. Any possible error that might be caught in a DFC macro would also be caught wherever the argument is used elsewhere. So creating multiple macro versions would add no useful error-checking and just further complicate an already complicated area. As for Martin's "ANSI aliasing" bug, XEmacs is not ANSI-aliasing clean and probably never will be. Unless the board agrees to change XEmacs in this way (and we really don't want to go down that road), this is not a bug. sound.h: Undo Martin's type change. signal.c: Fix problem identified by Martin with Linux and g++ due to non-standard declaration of setitimer(). systime.h: Update the docs for "qxe_" to point out why making the encapsulation explicit is always the right way to go. (setitimer() itself serves as an example.) For 21.4: update-elc-2.el: Correct misplaced parentheses, making lisp/mule not get recompiled.
author ben
date Mon, 18 Jun 2001 07:10:32 +0000
parents 023b83f4e54b
children b39c14581166
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* CCL (Code Conversion Language) interpreter.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2 Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 Licensed to the Free Software Foundation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 565
diff changeset
5 This file is part of XEmacs.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 565
diff changeset
7 XEmacs is free software; you can redistribute it and/or modify
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 it under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 565
diff changeset
12 XEmacs is distributed in the hope that it will be useful,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 GNU General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 565
diff changeset
18 along with XEmacs; see the file COPYING. If not, write to
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
22 /* Synched up with : FSF Emacs 21.0.90 except TranslateCharacter */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 #ifdef emacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 #include <config.h>
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
26 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
28 #include <stdio.h>
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
29
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
30 #ifdef emacs
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 #include "mule-charset.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 #include "mule-ccl.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 #include "file-coding.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 #else /* not emacs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 #include "mulelib.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 #endif /* not emacs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43
565
e9162e1ea200 [xemacs-hg @ 2001-05-24 09:53:05 by yoshiki]
yoshiki
parents: 563
diff changeset
44 Lisp_Object Qccl_error;
e9162e1ea200 [xemacs-hg @ 2001-05-24 09:53:05 by yoshiki]
yoshiki
parents: 563
diff changeset
45
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 /* This contains all code conversion map available to CCL. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 Lisp_Object Vcode_conversion_map_vector;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 /* Alist of fontname patterns vs corresponding CCL program. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 Lisp_Object Vfont_ccl_encoder_alist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
52 /* This symbol is a property which associates with ccl program vector.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 Ex: (get 'ccl-big5-encoder 'ccl-program) returns ccl program vector. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 Lisp_Object Qccl_program;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 /* These symbols are properties which associate with code conversion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 map and their ID respectively. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 Lisp_Object Qcode_conversion_map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 Lisp_Object Qcode_conversion_map_id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 /* Symbols of ccl program have this property, a value of the property
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
62 is an index for Vccl_program_table. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 Lisp_Object Qccl_program_idx;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
65 /* Table of registered CCL programs. Each element is a vector of
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
66 NAME, CCL_PROG, and RESOLVEDP where NAME (symbol) is the name of
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
67 the program, CCL_PROG (vector) is the compiled code of the program,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
68 RESOLVEDP (t or nil) is the flag to tell if symbols in CCL_PROG is
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
69 already resolved to index numbers or not. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 Lisp_Object Vccl_program_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 /* CCL (Code Conversion Language) is a simple language which has
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 operations on one input buffer, one output buffer, and 7 registers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 The syntax of CCL is described in `ccl.el'. Emacs Lisp function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 `ccl-compile' compiles a CCL program and produces a CCL code which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 is a vector of integers. The structure of this vector is as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 follows: The 1st element: buffer-magnification, a factor for the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 size of output buffer compared with the size of input buffer. The
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 2nd element: address of CCL code to be executed when encountered
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 with end of input stream. The 3rd and the remaining elements: CCL
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 codes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 /* Header of CCL compiled code */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 #define CCL_HEADER_BUF_MAG 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 #define CCL_HEADER_EOF 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 #define CCL_HEADER_MAIN 2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 /* CCL code is a sequence of 28-bit non-negative integers (i.e. the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 MSB is always 0), each contains CCL command and/or arguments in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 following format:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 |----------------- integer (28-bit) ------------------|
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 |------- 17-bit ------|- 3-bit --|- 3-bit --|- 5-bit -|
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 |--constant argument--|-register-|-register-|-command-|
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 ccccccccccccccccc RRR rrr XXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 |------- relative address -------|-register-|-command-|
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 cccccccccccccccccccc rrr XXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 |------------- constant or other args ----------------|
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 cccccccccccccccccccccccccccc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 where, `cc...c' is a non-negative integer indicating constant value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 (the left most `c' is always 0) or an absolute jump address, `RRR'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 and `rrr' are CCL register number, `XXXXX' is one of the following
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 CCL commands. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 /* CCL commands
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 Each comment fields shows one or more lines for command syntax and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 the following lines for semantics of the command. In semantics, IC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 stands for Instruction Counter. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 #define CCL_SetRegister 0x00 /* Set register a register value:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 1:00000000000000000RRRrrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 ------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 reg[rrr] = reg[RRR];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 #define CCL_SetShortConst 0x01 /* Set register a short constant value:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 ------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 reg[rrr] = CCCCCCCCCCCCCCCCCCC;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 #define CCL_SetConst 0x02 /* Set register a constant value:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 1:00000000000000000000rrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 2:CONSTANT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 ------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 reg[rrr] = CONSTANT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 IC++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 #define CCL_SetArray 0x03 /* Set register an element of array:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 1:CCCCCCCCCCCCCCCCCRRRrrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 2:ELEMENT[0]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 3:ELEMENT[1]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 ...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 ------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 if (0 <= reg[RRR] < CC..C)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 reg[rrr] = ELEMENT[reg[RRR]];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 IC += CC..C;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 #define CCL_Jump 0x04 /* Jump:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 1:A--D--D--R--E--S--S-000XXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 ------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 IC += ADDRESS;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 /* Note: If CC..C is greater than 0, the second code is omitted. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 #define CCL_JumpCond 0x05 /* Jump conditional:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 1:A--D--D--R--E--S--S-rrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 ------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 if (!reg[rrr])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 IC += ADDRESS;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 #define CCL_WriteRegisterJump 0x06 /* Write register and jump:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 1:A--D--D--R--E--S--S-rrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 ------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 write (reg[rrr]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 IC += ADDRESS;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 #define CCL_WriteRegisterReadJump 0x07 /* Write register, read, and jump:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 1:A--D--D--R--E--S--S-rrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 2:A--D--D--R--E--S--S-rrrYYYYY
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 -----------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 write (reg[rrr]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 IC++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 read (reg[rrr]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 IC += ADDRESS;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 /* Note: If read is suspended, the resumed execution starts from the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 second code (YYYYY == CCL_ReadJump). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 #define CCL_WriteConstJump 0x08 /* Write constant and jump:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 1:A--D--D--R--E--S--S-000XXXXX
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
182 2:CONST
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 ------------------------------
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
184 write (CONST);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 IC += ADDRESS;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 #define CCL_WriteConstReadJump 0x09 /* Write constant, read, and jump:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 1:A--D--D--R--E--S--S-rrrXXXXX
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
190 2:CONST
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 3:A--D--D--R--E--S--S-rrrYYYYY
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 -----------------------------
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
193 write (CONST);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 IC += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 read (reg[rrr]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 IC += ADDRESS;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 /* Note: If read is suspended, the resumed execution starts from the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 second code (YYYYY == CCL_ReadJump). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 #define CCL_WriteStringJump 0x0A /* Write string and jump:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 1:A--D--D--R--E--S--S-000XXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 2:LENGTH
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 3:0000STRIN[0]STRIN[1]STRIN[2]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 ...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 ------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 write_string (STRING, LENGTH);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 IC += ADDRESS;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 #define CCL_WriteArrayReadJump 0x0B /* Write an array element, read, and jump:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 1:A--D--D--R--E--S--S-rrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 2:LENGTH
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 3:ELEMENET[0]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 4:ELEMENET[1]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 ...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 N:A--D--D--R--E--S--S-rrrYYYYY
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 ------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 if (0 <= reg[rrr] < LENGTH)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 write (ELEMENT[reg[rrr]]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 IC += LENGTH + 2; (... pointing at N+1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 read (reg[rrr]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 IC += ADDRESS;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 /* Note: If read is suspended, the resumed execution starts from the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 Nth code (YYYYY == CCL_ReadJump). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 #define CCL_ReadJump 0x0C /* Read and jump:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 1:A--D--D--R--E--S--S-rrrYYYYY
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 -----------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 read (reg[rrr]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 IC += ADDRESS;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 #define CCL_Branch 0x0D /* Jump by branch table:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 2:A--D--D--R--E-S-S[0]000XXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 3:A--D--D--R--E-S-S[1]000XXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 ...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 ------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 if (0 <= reg[rrr] < CC..C)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 IC += ADDRESS[reg[rrr]];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 IC += ADDRESS[CC..C];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 #define CCL_ReadRegister 0x0E /* Read bytes into registers:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 2:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 ...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 ------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 while (CCC--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 read (reg[rrr]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 #define CCL_WriteExprConst 0x0F /* write result of expression:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 1:00000OPERATION000RRR000XXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 2:CONSTANT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 ------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 write (reg[RRR] OPERATION CONSTANT);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 IC++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 /* Note: If the Nth read is suspended, the resumed execution starts
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 from the Nth code. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 #define CCL_ReadBranch 0x10 /* Read one byte into a register,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 and jump by branch table:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 2:A--D--D--R--E-S-S[0]000XXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 3:A--D--D--R--E-S-S[1]000XXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 ...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 ------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 read (read[rrr]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 if (0 <= reg[rrr] < CC..C)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 IC += ADDRESS[reg[rrr]];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 IC += ADDRESS[CC..C];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 #define CCL_WriteRegister 0x11 /* Write registers:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 1:CCCCCCCCCCCCCCCCCCCrrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 2:CCCCCCCCCCCCCCCCCCCrrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 ...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 ------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 while (CCC--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 write (reg[rrr]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 ...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 /* Note: If the Nth write is suspended, the resumed execution
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 starts from the Nth code. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 #define CCL_WriteExprRegister 0x12 /* Write result of expression
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 1:00000OPERATIONRrrRRR000XXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 ------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 write (reg[RRR] OPERATION reg[Rrr]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 #define CCL_Call 0x13 /* Call the CCL program whose ID is
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
301 CC..C or cc..c.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
302 1:CCCCCCCCCCCCCCCCCCCCFFFXXXXX
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
303 [2:00000000cccccccccccccccccccc]
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 ------------------------------
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
305 if (FFF)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
306 call (cc..c)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
307 IC++;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
308 else
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
309 call (CC..C)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 #define CCL_WriteConstString 0x14 /* Write a constant or a string:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 [2:0000STRIN[0]STRIN[1]STRIN[2]]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 [...]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 -----------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 if (!rrr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 write (CC..C)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 write_string (STRING, CC..C);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 IC += (CC..C + 2) / 3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 #define CCL_WriteArray 0x15 /* Write an element of array:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 2:ELEMENT[0]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 3:ELEMENT[1]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 ...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 ------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 if (0 <= reg[rrr] < CC..C)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 write (ELEMENT[reg[rrr]]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 IC += CC..C;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 #define CCL_End 0x16 /* Terminate:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 1:00000000000000000000000XXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 ------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 terminate ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 /* The following two codes execute an assignment arithmetic/logical
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 operation. The form of the operation is like REG OP= OPERAND. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 #define CCL_ExprSelfConst 0x17 /* REG OP= constant:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 1:00000OPERATION000000rrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 2:CONSTANT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 ------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 reg[rrr] OPERATION= CONSTANT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 #define CCL_ExprSelfReg 0x18 /* REG1 OP= REG2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 1:00000OPERATION000RRRrrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 ------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 reg[rrr] OPERATION= reg[RRR];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 /* The following codes execute an arithmetic/logical operation. The
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 form of the operation is like REG_X = REG_Y OP OPERAND2. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 #define CCL_SetExprConst 0x19 /* REG_X = REG_Y OP constant:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 1:00000OPERATION000RRRrrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 2:CONSTANT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 ------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 reg[rrr] = reg[RRR] OPERATION CONSTANT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 IC++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 #define CCL_SetExprReg 0x1A /* REG1 = REG2 OP REG3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 1:00000OPERATIONRrrRRRrrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 ------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 reg[rrr] = reg[RRR] OPERATION reg[Rrr];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 #define CCL_JumpCondExprConst 0x1B /* Jump conditional according to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 an operation on constant:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 1:A--D--D--R--E--S--S-rrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 2:OPERATION
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 3:CONSTANT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 -----------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 reg[7] = reg[rrr] OPERATION CONSTANT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 if (!(reg[7]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 IC += ADDRESS;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 IC += 2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 #define CCL_JumpCondExprReg 0x1C /* Jump conditional according to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 an operation on register:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 1:A--D--D--R--E--S--S-rrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 2:OPERATION
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 3:RRR
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 -----------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 reg[7] = reg[rrr] OPERATION reg[RRR];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 if (!reg[7])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 IC += ADDRESS;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 IC += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 #define CCL_ReadJumpCondExprConst 0x1D /* Read and jump conditional according
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 to an operation on constant:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 1:A--D--D--R--E--S--S-rrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 2:OPERATION
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 3:CONSTANT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 -----------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 read (reg[rrr]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 reg[7] = reg[rrr] OPERATION CONSTANT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 if (!reg[7])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 IC += ADDRESS;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 IC += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 #define CCL_ReadJumpCondExprReg 0x1E /* Read and jump conditional according
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 to an operation on register:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 1:A--D--D--R--E--S--S-rrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 2:OPERATION
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 3:RRR
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 -----------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 read (reg[rrr]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 reg[7] = reg[rrr] OPERATION reg[RRR];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 if (!reg[7])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 IC += ADDRESS;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 IC += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
428 #define CCL_Extension 0x1F /* Extended CCL code
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 1:ExtendedCOMMNDRrrRRRrrrXXXXX
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
430 2:ARGUMENT
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 3:...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 ------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 extended_command (rrr,RRR,Rrr,ARGS)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
436 /*
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 Here after, Extended CCL Instructions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 Bit length of extended command is 14.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 Therefore, the instruction code range is 0..16384(0x3fff).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 /* Read a multibyte characeter.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 A code point is stored into reg[rrr]. A charset ID is stored into
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 reg[RRR]. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 #define CCL_ReadMultibyteChar2 0x00 /* Read Multibyte Character
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 1:ExtendedCOMMNDRrrRRRrrrXXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 /* Write a multibyte character.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 Write a character whose code point is reg[rrr] and the charset ID
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 is reg[RRR]. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 #define CCL_WriteMultibyteChar2 0x01 /* Write Multibyte Character
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 1:ExtendedCOMMNDRrrRRRrrrXXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 /* Translate a character whose code point is reg[rrr] and the charset
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 ID is reg[RRR] by a translation table whose ID is reg[Rrr].
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 A translated character is set in reg[rrr] (code point) and reg[RRR]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 (charset ID). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 #define CCL_TranslateCharacter 0x02 /* Translate a multibyte character
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 1:ExtendedCOMMNDRrrRRRrrrXXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 /* Translate a character whose code point is reg[rrr] and the charset
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 ID is reg[RRR] by a translation table whose ID is ARGUMENT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 A translated character is set in reg[rrr] (code point) and reg[RRR]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 (charset ID). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 #define CCL_TranslateCharacterConstTbl 0x03 /* Translate a multibyte character
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 1:ExtendedCOMMNDRrrRRRrrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 2:ARGUMENT(Translation Table ID)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 /* Iterate looking up MAPs for reg[rrr] starting from the Nth (N =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 reg[RRR]) MAP until some value is found.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 Each MAP is a Lisp vector whose element is number, nil, t, or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 lambda.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 If the element is nil, ignore the map and proceed to the next map.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 If the element is t or lambda, finish without changing reg[rrr].
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 If the element is a number, set reg[rrr] to the number and finish.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
485 Detail of the map structure is described in the comment for
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 CCL_MapMultiple below. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 #define CCL_IterateMultipleMap 0x10 /* Iterate multiple maps
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 1:ExtendedCOMMNDXXXRRRrrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 2:NUMBER of MAPs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 3:MAP-ID1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 4:MAP-ID2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 ...
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
494 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 /* Map the code in reg[rrr] by MAPs starting from the Nth (N =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 reg[RRR]) map.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 MAPs are supplied in the succeeding CCL codes as follows:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 When CCL program gives this nested structure of map to this command:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 ((MAP-ID11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 MAP-ID12
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 (MAP-ID121 MAP-ID122 MAP-ID123)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 MAP-ID13)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 (MAP-ID21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 (MAP-ID211 (MAP-ID2111) MAP-ID212)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 MAP-ID22)),
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
509 the compiled CCL code has this sequence:
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 CCL_MapMultiple (CCL code of this command)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 16 (total number of MAPs and SEPARATORs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 -7 (1st SEPARATOR)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 MAP-ID11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 MAP-ID12
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 -3 (2nd SEPARATOR)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 MAP-ID121
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 MAP-ID122
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 MAP-ID123
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 MAP-ID13
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 -7 (3rd SEPARATOR)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 MAP-ID21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 -4 (4th SEPARATOR)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 MAP-ID211
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 -1 (5th SEPARATOR)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 MAP_ID2111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 MAP-ID212
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 MAP-ID22
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 A value of each SEPARATOR follows this rule:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 MAP-SET := SEPARATOR [(MAP-ID | MAP-SET)]+
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 SEPARATOR := -(number of MAP-IDs and SEPARATORs in the MAP-SET)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 (*)....Nest level of MAP-SET must not be over than MAX_MAP_SET_LEVEL.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 When some map fails to map (i.e. it doesn't have a value for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 reg[rrr]), the mapping is treated as identity.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 The mapping is iterated for all maps in each map set (set of maps
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 separated by SEPARATOR) except in the case that lambda is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 encountered. More precisely, the mapping proceeds as below:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 At first, VAL0 is set to reg[rrr], and it is translated by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 first map to VAL1. Then, VAL1 is translated by the next map to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 VAL2. This mapping is iterated until the last map is used. The
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
545 result of the mapping is the last value of VAL?. When the mapping
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
546 process reached to the end of the map set, it moves to the next
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
547 map set. If the next does not exit, the mapping process terminates,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
548 and regard the last value as a result.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 But, when VALm is mapped to VALn and VALn is not a number, the
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
551 mapping proceeds as follows:
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 If VALn is nil, the lastest map is ignored and the mapping of VALm
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
554 proceeds to the next map.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 In VALn is t, VALm is reverted to reg[rrr] and the mapping of VALm
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
557 proceeds to the next map.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
559 If VALn is lambda, move to the next map set like reaching to the
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
560 end of the current map set.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
561
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
562 If VALn is a symbol, call the CCL program refered by it.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
563 Then, use reg[rrr] as a mapped value except for -1, -2 and -3.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
564 Such special values are regarded as nil, t, and lambda respectively.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 Each map is a Lisp vector of the following format (a) or (b):
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 (a)......[STARTPOINT VAL1 VAL2 ...]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 (b)......[t VAL STARTPOINT ENDPOINT],
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 where
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 STARTPOINT is an offset to be used for indexing a map,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 ENDPOINT is a maximum index number of a map,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
572 VAL and VALn is a number, nil, t, or lambda.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 Valid index range of a map of type (a) is:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 STARTPOINT <= index < STARTPOINT + map_size - 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 Valid index range of a map of type (b) is:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 STARTPOINT <= index < ENDPOINT */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 #define CCL_MapMultiple 0x11 /* Mapping by multiple code conversion maps
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 1:ExtendedCOMMNDXXXRRRrrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 2:N-2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 3:SEPARATOR_1 (< 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 4:MAP-ID_1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 5:MAP-ID_2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 ...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 M:SEPARATOR_x (< 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 M+1:MAP-ID_y
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 ...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 N:SEPARATOR_z (< 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
592 #define MAX_MAP_SET_LEVEL 30
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 typedef struct
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 int rest_length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 int orig_val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 } tr_stack;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 static tr_stack mapping_stack[MAX_MAP_SET_LEVEL];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 static tr_stack *mapping_stack_pointer;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
602
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
603 /* If this variable is non-zero, it indicates the stack_idx
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
604 of immediately called by CCL_MapMultiple. */
450
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
605 static int stack_idx_of_map_multiple;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
606
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
607 #define PUSH_MAPPING_STACK(restlen, orig) \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
608 do { \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
609 mapping_stack_pointer->rest_length = (restlen); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
610 mapping_stack_pointer->orig_val = (orig); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
611 mapping_stack_pointer++; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
612 } while (0)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
613
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
614 #define POP_MAPPING_STACK(restlen, orig) \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
615 do { \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
616 mapping_stack_pointer--; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
617 (restlen) = mapping_stack_pointer->rest_length; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
618 (orig) = mapping_stack_pointer->orig_val; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
619 } while (0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
621 #define CCL_CALL_FOR_MAP_INSTRUCTION(symbol, ret_ic) \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
622 do { \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
623 struct ccl_program called_ccl; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
624 if (stack_idx >= 256 \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
625 || (setup_ccl_program (&called_ccl, (symbol)) != 0)) \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
626 { \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
627 if (stack_idx > 0) \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
628 { \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
629 ccl_prog = ccl_prog_stack_struct[0].ccl_prog; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
630 ic = ccl_prog_stack_struct[0].ic; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
631 } \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
632 CCL_INVALID_CMD; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
633 } \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
634 ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
635 ccl_prog_stack_struct[stack_idx].ic = (ret_ic); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
636 stack_idx++; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
637 ccl_prog = called_ccl.prog; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
638 ic = CCL_HEADER_MAIN; \
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
639 /* The "if (1)" prevents warning \
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
640 "end-of loop code not reached" */ \
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
641 if (1) goto ccl_repeat; \
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
642 } while (0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 #define CCL_MapSingle 0x12 /* Map by single code conversion map
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 1:ExtendedCOMMNDXXXRRRrrrXXXXX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 2:MAP-ID
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 ------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 Map reg[rrr] by MAP-ID.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 If some valid mapping is found,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 set reg[rrr] to the result,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 set reg[RRR] to -1.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 /* CCL arithmetic/logical operators. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 #define CCL_PLUS 0x00 /* X = Y + Z */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 #define CCL_MINUS 0x01 /* X = Y - Z */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 #define CCL_MUL 0x02 /* X = Y * Z */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 #define CCL_DIV 0x03 /* X = Y / Z */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 #define CCL_MOD 0x04 /* X = Y % Z */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 #define CCL_AND 0x05 /* X = Y & Z */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 #define CCL_OR 0x06 /* X = Y | Z */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 #define CCL_XOR 0x07 /* X = Y ^ Z */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 #define CCL_LSH 0x08 /* X = Y << Z */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 #define CCL_RSH 0x09 /* X = Y >> Z */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 #define CCL_LSH8 0x0A /* X = (Y << 8) | Z */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 #define CCL_RSH8 0x0B /* X = Y >> 8, r[7] = Y & 0xFF */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 #define CCL_DIVMOD 0x0C /* X = Y / Z, r[7] = Y % Z */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 #define CCL_LS 0x10 /* X = (X < Y) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 #define CCL_GT 0x11 /* X = (X > Y) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 #define CCL_EQ 0x12 /* X = (X == Y) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 #define CCL_LE 0x13 /* X = (X <= Y) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 #define CCL_GE 0x14 /* X = (X >= Y) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 #define CCL_NE 0x15 /* X = (X != Y) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 #define CCL_DECODE_SJIS 0x16 /* X = HIGHER_BYTE (DE-SJIS (Y, Z))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 r[7] = LOWER_BYTE (DE-SJIS (Y, Z)) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 #define CCL_ENCODE_SJIS 0x17 /* X = HIGHER_BYTE (SJIS (Y, Z))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 r[7] = LOWER_BYTE (SJIS (Y, Z) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
681 /* Terminate CCL program successfully. */
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
682 #define CCL_SUCCESS \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
683 do { \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
684 ccl->status = CCL_STAT_SUCCESS; \
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
685 /* The "if (1)" inhibits the warning \
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
686 "end-of loop code not reached" */ \
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
687 if (1) goto ccl_finish; \
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
688 } while (0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
689
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 /* Suspend CCL program because of reading from empty input buffer or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 writing to full output buffer. When this program is resumed, the
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
692 same I/O command is executed. */
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
693 #define CCL_SUSPEND(stat) \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
694 do { \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
695 ic--; \
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
696 ccl->status = (stat); \
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
697 /* The "if (1)" inhibits the warning \
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
698 "end-of loop code not reached" */ \
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
699 if (1) goto ccl_finish; \
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
700 } while (0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 /* Terminate CCL program because of invalid command. Should not occur
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
703 in the normal case. */
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
704 #define CCL_INVALID_CMD \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
705 do { \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
706 ccl->status = CCL_STAT_INVALID_CMD; \
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
707 /* The "if (1)" inhibits the warning \
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
708 "end-of loop code not reached" */ \
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
709 if (1) goto ccl_error_handler; \
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
710 } while (0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 /* Encode one character CH to multibyte form and write to the current
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
713 output buffer. At encoding time, if CH is less than 256, CH is
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
714 written as is. At decoding time, if CH cannot be regarded as an
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
715 ASCII character, write it in multibyte form. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
716 #define CCL_WRITE_CHAR(ch) \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
717 do { \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
718 if (!destination) \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
719 CCL_INVALID_CMD; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
720 if (conversion_mode == CCL_MODE_ENCODING) \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
721 { \
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
722 if ((ch) == '\n') \
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
723 { \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
724 if (ccl->eol_type == CCL_CODING_EOL_CRLF) \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
725 { \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
726 Dynarr_add (destination, '\r'); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
727 Dynarr_add (destination, '\n'); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
728 } \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
729 else if (ccl->eol_type == CCL_CODING_EOL_CR) \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
730 Dynarr_add (destination, '\r'); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
731 else \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
732 Dynarr_add (destination, '\n'); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
733 } \
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
734 else if ((ch) < 0x100) \
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
735 { \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
736 Dynarr_add (destination, ch); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
737 } \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
738 else \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
739 { \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
740 Bufbyte work[MAX_EMCHAR_LEN]; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
741 int len; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
742 len = non_ascii_set_charptr_emchar (work, ch); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
743 Dynarr_add_many (destination, work, len); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
744 } \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
745 } \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
746 else \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
747 { \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
748 if (!CHAR_MULTIBYTE_P(ch)) \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
749 { \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
750 Dynarr_add (destination, ch); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
751 } \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
752 else \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
753 { \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
754 Bufbyte work[MAX_EMCHAR_LEN]; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
755 int len; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
756 len = non_ascii_set_charptr_emchar (work, ch); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
757 Dynarr_add_many (destination, work, len); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
758 } \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
759 } \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
760 } while (0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 /* Write a string at ccl_prog[IC] of length LEN to the current output
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
763 buffer. But this macro treat this string as a binary. Therefore,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
764 cannot handle a multibyte string except for Control-1 characters. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
765 #define CCL_WRITE_STRING(len) \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
766 do { \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
767 Bufbyte work[MAX_EMCHAR_LEN]; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
768 int ch, bytes; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
769 if (!destination) \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
770 CCL_INVALID_CMD; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
771 else if (conversion_mode == CCL_MODE_ENCODING) \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
772 { \
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
773 for (i = 0; i < (len); i++) \
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
774 { \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
775 ch = ((XINT (ccl_prog[ic + (i / 3)])) \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
776 >> ((2 - (i % 3)) * 8)) & 0xFF; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
777 if (ch == '\n') \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
778 { \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
779 if (ccl->eol_type == CCL_CODING_EOL_CRLF) \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
780 { \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
781 Dynarr_add (destination, '\r'); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
782 Dynarr_add (destination, '\n'); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
783 } \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
784 else if (ccl->eol_type == CCL_CODING_EOL_CR) \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
785 Dynarr_add (destination, '\r'); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
786 else \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
787 Dynarr_add (destination, '\n'); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
788 } \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
789 if (ch < 0x100) \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
790 { \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
791 Dynarr_add (destination, ch); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
792 } \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
793 else \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
794 { \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
795 bytes = non_ascii_set_charptr_emchar (work, ch); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
796 Dynarr_add_many (destination, work, len); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
797 } \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
798 } \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
799 } \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
800 else \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
801 { \
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
802 for (i = 0; i < (len); i++) \
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
803 { \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
804 ch = ((XINT (ccl_prog[ic + (i / 3)])) \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
805 >> ((2 - (i % 3)) * 8)) & 0xFF; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
806 if (!CHAR_MULTIBYTE_P(ch)) \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
807 { \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
808 Dynarr_add (destination, ch); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
809 } \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
810 else \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
811 { \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
812 bytes = non_ascii_set_charptr_emchar (work, ch); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
813 Dynarr_add_many (destination, work, len); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
814 } \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
815 } \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
816 } \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
817 } while (0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 /* Read one byte from the current input buffer into Rth register. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
820 #define CCL_READ_CHAR(r) \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
821 do { \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
822 if (!src) \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
823 CCL_INVALID_CMD; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
824 if (src < src_end) \
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
825 (r) = *src++; \
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
826 else \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
827 { \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
828 if (ccl->last_block) \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
829 { \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
830 ic = ccl->eof_ic; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
831 goto ccl_repeat; \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
832 } \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
833 else \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
834 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC); \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
835 } \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
836 } while (0)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
837
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
838
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
839 /* Set C to the character code made from CHARSET and CODE. This is
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
840 like MAKE_CHAR but check the validity of CHARSET and CODE. If they
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
841 are not valid, set C to (CODE & 0xFF) because that is usually the
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
842 case that CCL_ReadMultibyteChar2 read an invalid code and it set
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
843 CODE to that invalid byte. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
844
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
845 /* On XEmacs, TranslateCharacter is not supported. Thus, this
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
846 macro is not used. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
847 #if 0
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
848 #define CCL_MAKE_CHAR(charset, code, c) \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
849 do { \
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
850 if ((charset) == CHARSET_ASCII) \
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
851 (c) = (code) & 0xFF; \
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
852 else if (CHARSET_DEFINED_P (charset) \
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
853 && ((code) & 0x7F) >= 32 \
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
854 && ((code) < 256 || ((code >> 7) & 0x7F) >= 32)) \
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
855 { \
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
856 int c1 = (code) & 0x7F, c2 = 0; \
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
857 \
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
858 if ((code) >= 256) \
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
859 c2 = c1, c1 = ((code) >> 7) & 0x7F; \
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
860 (c) = MAKE_CHAR (charset, c1, c2); \
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
861 } \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
862 else \
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
863 (c) = (code) & 0xFF; \
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
864 } while (0)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
865 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 /* Execute CCL code on SRC_BYTES length text at SOURCE. The resulting
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
869 text goes to a place pointed by DESTINATION, the length of which
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
870 should not exceed DST_BYTES. The bytes actually processed is
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
871 returned as *CONSUMED. The return value is the length of the
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
872 resulting text. As a side effect, the contents of CCL registers
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 are updated. If SOURCE or DESTINATION is NULL, only operations on
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 registers are permitted. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 #ifdef CCL_DEBUG
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 #define CCL_DEBUG_BACKTRACE_LEN 256
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 int ccl_backtrace_table[CCL_BACKTRACE_TABLE];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 int ccl_backtrace_idx;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 struct ccl_prog_stack
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 Lisp_Object *ccl_prog; /* Pointer to an array of CCL code. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 int ic; /* Instruction Counter. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
888 /* For the moment, we only support depth 256 of stack. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 static struct ccl_prog_stack ccl_prog_stack_struct[256];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 int
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
892 ccl_driver (struct ccl_program *ccl,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
893 const unsigned char *source,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
894 unsigned_char_dynarr *destination,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
895 int src_bytes,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
896 int *consumed,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
897 int conversion_mode)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
899 register int *reg = ccl->reg;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
900 register int ic = ccl->ic;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
901 register int code = -1;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
902 register int field1, field2;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
903 register Lisp_Object *ccl_prog = ccl->prog;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
904 const unsigned char *src = source, *src_end = src + src_bytes;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
905 int jump_address;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 int i, j, op;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 int stack_idx = ccl->stack_idx;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 /* Instruction counter of the current CCL code. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 int this_ic = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 if (ic >= ccl->eof_ic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 ic = CCL_HEADER_MAIN;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 if (ccl->buf_magnification ==0) /* We can't produce any bytes. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
915 destination = NULL;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
916
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
917 /* Set mapping stack pointer. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
918 mapping_stack_pointer = mapping_stack;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 #ifdef CCL_DEBUG
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 ccl_backtrace_idx = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 for (;;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 ccl_repeat:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 #ifdef CCL_DEBUG
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 ccl_backtrace_table[ccl_backtrace_idx++] = ic;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 if (ccl_backtrace_idx >= CCL_DEBUG_BACKTRACE_LEN)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 ccl_backtrace_idx = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 ccl_backtrace_table[ccl_backtrace_idx] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 /* We can't just signal Qquit, instead break the loop as if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 the whole data is processed. Don't reset Vquit_flag, it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 must be handled later at a safer place. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 if (consumed)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 src = source + src_bytes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 ccl->status = CCL_STAT_QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 this_ic = ic;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 code = XINT (ccl_prog[ic]); ic++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 field1 = code >> 8;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 field2 = (code & 0xFF) >> 5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 #define rrr field2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 #define RRR (field1 & 7)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 #define Rrr ((field1 >> 3) & 7)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 #define ADDR field1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 #define EXCMD (field1 >> 6)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 switch (code & 0x1F)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 case CCL_SetRegister: /* 00000000000000000RRRrrrXXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 reg[rrr] = reg[RRR];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 case CCL_SetShortConst: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 reg[rrr] = field1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 case CCL_SetConst: /* 00000000000000000000rrrXXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 reg[rrr] = XINT (ccl_prog[ic]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 ic++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 case CCL_SetArray: /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 i = reg[RRR];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 j = field1 >> 3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 if ((unsigned int) i < j)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 reg[rrr] = XINT (ccl_prog[ic + i]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 ic += j;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 case CCL_Jump: /* A--D--D--R--E--S--S-000XXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980 ic += ADDR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 case CCL_JumpCond: /* A--D--D--R--E--S--S-rrrXXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 if (!reg[rrr])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 ic += ADDR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 case CCL_WriteRegisterJump: /* A--D--D--R--E--S--S-rrrXXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 i = reg[rrr];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 CCL_WRITE_CHAR (i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 ic += ADDR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 case CCL_WriteRegisterReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 i = reg[rrr];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 CCL_WRITE_CHAR (i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 ic++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 CCL_READ_CHAR (reg[rrr]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 ic += ADDR - 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 case CCL_WriteConstJump: /* A--D--D--R--E--S--S-000XXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 i = XINT (ccl_prog[ic]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 CCL_WRITE_CHAR (i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 ic += ADDR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 case CCL_WriteConstReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 i = XINT (ccl_prog[ic]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 CCL_WRITE_CHAR (i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 ic++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 CCL_READ_CHAR (reg[rrr]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 ic += ADDR - 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 case CCL_WriteStringJump: /* A--D--D--R--E--S--S-000XXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 j = XINT (ccl_prog[ic]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 ic++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 CCL_WRITE_STRING (j);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 ic += ADDR - 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 case CCL_WriteArrayReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 i = reg[rrr];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 j = XINT (ccl_prog[ic]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 if ((unsigned int) i < j)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 i = XINT (ccl_prog[ic + 1 + i]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 CCL_WRITE_CHAR (i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 ic += j + 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 CCL_READ_CHAR (reg[rrr]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 ic += ADDR - (j + 2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 case CCL_ReadJump: /* A--D--D--R--E--S--S-rrrYYYYY */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 CCL_READ_CHAR (reg[rrr]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 ic += ADDR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 case CCL_ReadBranch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 CCL_READ_CHAR (reg[rrr]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 /* fall through ... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 case CCL_Branch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 if ((unsigned int) reg[rrr] < field1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 ic += XINT (ccl_prog[ic + reg[rrr]]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 ic += XINT (ccl_prog[ic + field1]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 case CCL_ReadRegister: /* CCCCCCCCCCCCCCCCCCCCrrXXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 CCL_READ_CHAR (reg[rrr]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 if (!field1) break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 code = XINT (ccl_prog[ic]); ic++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 field1 = code >> 8;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 field2 = (code & 0xFF) >> 5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 case CCL_WriteExprConst: /* 1:00000OPERATION000RRR000XXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 rrr = 7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 i = reg[RRR];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 j = XINT (ccl_prog[ic]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 op = field1 >> 6;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1067 jump_address = ic + 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 goto ccl_set_expr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 case CCL_WriteRegister: /* CCCCCCCCCCCCCCCCCCCrrrXXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 i = reg[rrr];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 CCL_WRITE_CHAR (i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 if (!field1) break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 code = XINT (ccl_prog[ic]); ic++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 field1 = code >> 8;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 field2 = (code & 0xFF) >> 5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 case CCL_WriteExprRegister: /* 1:00000OPERATIONRrrRRR000XXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 rrr = 7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 i = reg[RRR];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 j = reg[Rrr];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 op = field1 >> 6;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1087 jump_address = ic;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 goto ccl_set_expr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1090 case CCL_Call: /* 1:CCCCCCCCCCCCCCCCCCCCFFFXXXXX */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 Lisp_Object slot;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1093 int prog_id;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1094
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1095 /* If FFF is nonzero, the CCL program ID is in the
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1096 following code. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1097 if (rrr)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1098 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1099 prog_id = XINT (ccl_prog[ic]);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1100 ic++;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1101 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1102 else
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1103 prog_id = field1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 if (stack_idx >= 256
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1106 || prog_id < 0
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1107 || prog_id >= XVECTOR (Vccl_program_table)->size
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1108 || (slot = XVECTOR (Vccl_program_table)->contents[prog_id],
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1109 !VECTORP (slot))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1110 || !VECTORP (XVECTOR (slot)->contents[1]))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 if (stack_idx > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114 ccl_prog = ccl_prog_stack_struct[0].ccl_prog;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115 ic = ccl_prog_stack_struct[0].ic;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 }
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1117 CCL_INVALID_CMD;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 ccl_prog_stack_struct[stack_idx].ic = ic;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122 stack_idx++;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1123 ccl_prog = XVECTOR (XVECTOR (slot)->contents[1])->contents;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 ic = CCL_HEADER_MAIN;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 case CCL_WriteConstString: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129 if (!rrr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 CCL_WRITE_CHAR (field1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133 CCL_WRITE_STRING (field1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 ic += (field1 + 2) / 3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 case CCL_WriteArray: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 i = reg[rrr];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 if ((unsigned int) i < field1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 j = XINT (ccl_prog[ic + i]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 CCL_WRITE_CHAR (j);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 ic += field1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 case CCL_End: /* 0000000000000000000000XXXXX */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1149 if (stack_idx > 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1151 stack_idx--;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 ic = ccl_prog_stack_struct[stack_idx].ic;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 if (src)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157 src = src_end;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 /* ccl->ic should points to this command code again to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 suppress further processing. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 ic--;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1161 CCL_SUCCESS;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 i = XINT (ccl_prog[ic]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 ic++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 op = field1 >> 6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 goto ccl_expr_self;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 case CCL_ExprSelfReg: /* 00000OPERATION000RRRrrrXXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 i = reg[RRR];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 op = field1 >> 6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 ccl_expr_self:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 switch (op)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 case CCL_PLUS: reg[rrr] += i; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 case CCL_MINUS: reg[rrr] -= i; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 case CCL_MUL: reg[rrr] *= i; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 case CCL_DIV: reg[rrr] /= i; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 case CCL_MOD: reg[rrr] %= i; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 case CCL_AND: reg[rrr] &= i; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 case CCL_OR: reg[rrr] |= i; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 case CCL_XOR: reg[rrr] ^= i; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 case CCL_LSH: reg[rrr] <<= i; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 case CCL_RSH: reg[rrr] >>= i; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 case CCL_LSH8: reg[rrr] <<= 8; reg[rrr] |= i; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 case CCL_RSH8: reg[7] = reg[rrr] & 0xFF; reg[rrr] >>= 8; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 case CCL_DIVMOD: reg[7] = reg[rrr] % i; reg[rrr] /= i; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 case CCL_LS: reg[rrr] = reg[rrr] < i; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 case CCL_GT: reg[rrr] = reg[rrr] > i; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 case CCL_EQ: reg[rrr] = reg[rrr] == i; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 case CCL_LE: reg[rrr] = reg[rrr] <= i; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 case CCL_GE: reg[rrr] = reg[rrr] >= i; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 case CCL_NE: reg[rrr] = reg[rrr] != i; break;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1195 default: CCL_INVALID_CMD;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 case CCL_SetExprConst: /* 00000OPERATION000RRRrrrXXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 i = reg[RRR];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 j = XINT (ccl_prog[ic]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 op = field1 >> 6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 jump_address = ++ic;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 goto ccl_set_expr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 case CCL_SetExprReg: /* 00000OPERATIONRrrRRRrrrXXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 i = reg[RRR];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 j = reg[Rrr];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 op = field1 >> 6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 jump_address = ic;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211 goto ccl_set_expr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213 case CCL_ReadJumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 CCL_READ_CHAR (reg[rrr]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 i = reg[rrr];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 op = XINT (ccl_prog[ic]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 jump_address = ic++ + ADDR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 j = XINT (ccl_prog[ic]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 ic++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 rrr = 7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 goto ccl_set_expr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 case CCL_ReadJumpCondExprReg: /* A--D--D--R--E--S--S-rrrXXXXX */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 CCL_READ_CHAR (reg[rrr]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 case CCL_JumpCondExprReg:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 i = reg[rrr];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 op = XINT (ccl_prog[ic]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229 jump_address = ic++ + ADDR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 j = reg[XINT (ccl_prog[ic])];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 ic++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 rrr = 7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 ccl_set_expr:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 switch (op)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237 case CCL_PLUS: reg[rrr] = i + j; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 case CCL_MINUS: reg[rrr] = i - j; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 case CCL_MUL: reg[rrr] = i * j; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 case CCL_DIV: reg[rrr] = i / j; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 case CCL_MOD: reg[rrr] = i % j; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242 case CCL_AND: reg[rrr] = i & j; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 case CCL_OR: reg[rrr] = i | j; break;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1244 case CCL_XOR: reg[rrr] = i ^ j;; break;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 case CCL_LSH: reg[rrr] = i << j; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 case CCL_RSH: reg[rrr] = i >> j; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 case CCL_LSH8: reg[rrr] = (i << 8) | j; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248 case CCL_RSH8: reg[rrr] = i >> 8; reg[7] = i & 0xFF; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 case CCL_DIVMOD: reg[rrr] = i / j; reg[7] = i % j; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 case CCL_LS: reg[rrr] = i < j; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 case CCL_GT: reg[rrr] = i > j; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 case CCL_EQ: reg[rrr] = i == j; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 case CCL_LE: reg[rrr] = i <= j; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 case CCL_GE: reg[rrr] = i >= j; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 case CCL_NE: reg[rrr] = i != j; break;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1256 case CCL_DECODE_SJIS:
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1257 /* DECODE_SJIS set MSB for internal format
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1258 as opposed to Emacs. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1259 DECODE_SJIS (i, j, reg[rrr], reg[7]);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1260 reg[rrr] &= 0x7F;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1261 reg[7] &= 0x7F;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1262 break;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1263 case CCL_ENCODE_SJIS:
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1264 /* ENCODE_SJIS assumes MSB of SJIS-char is set
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1265 as opposed to Emacs. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1266 ENCODE_SJIS (i | 0x80, j | 0x80, reg[rrr], reg[7]);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1267 break;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1268 default: CCL_INVALID_CMD;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 code &= 0x1F;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 if (code == CCL_WriteExprConst || code == CCL_WriteExprRegister)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 i = reg[rrr];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 CCL_WRITE_CHAR (i);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1275 ic = jump_address;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 else if (!reg[rrr])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 ic = jump_address;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
1281 case CCL_Extension:
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 switch (EXCMD)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 case CCL_ReadMultibyteChar2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 if (!src)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 CCL_INVALID_CMD;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1288 if (src >= src_end)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1289 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1290 src++;
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 450
diff changeset
1291 goto ccl_read_multibyte_character_suspend;
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1292 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1293
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1294 i = *src++;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1295 if (i < 0x80)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1296 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1297 /* ASCII */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1298 reg[rrr] = i;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1299 reg[RRR] = LEADING_BYTE_ASCII;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1300 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1301 else if (i <= MAX_LEADING_BYTE_OFFICIAL_1)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1302 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1303 if (src >= src_end)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1304 goto ccl_read_multibyte_character_suspend;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1305 reg[RRR] = i;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1306 reg[rrr] = (*src++ & 0x7F);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1307 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1308 else if (i <= MAX_LEADING_BYTE_OFFICIAL_2)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1309 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1310 if ((src + 1) >= src_end)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1311 goto ccl_read_multibyte_character_suspend;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1312 reg[RRR] = i;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1313 i = (*src++ & 0x7F);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1314 reg[rrr] = ((i << 7) | (*src & 0x7F));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1315 src++;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1316 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1317 else if (i == PRE_LEADING_BYTE_PRIVATE_1)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1318 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1319 if ((src + 1) >= src_end)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1320 goto ccl_read_multibyte_character_suspend;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1321 reg[RRR] = *src++;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1322 reg[rrr] = (*src++ & 0x7F);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1323 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1324 else if (i == PRE_LEADING_BYTE_PRIVATE_2)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1325 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1326 if ((src + 2) >= src_end)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1327 goto ccl_read_multibyte_character_suspend;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1328 reg[RRR] = *src++;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1329 i = (*src++ & 0x7F);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1330 reg[rrr] = ((i << 7) | (*src & 0x7F));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1331 src++;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1332 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1333 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1334 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1335 /* INVALID CODE. Return a single byte character. */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1336 reg[RRR] = LEADING_BYTE_ASCII;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1337 reg[rrr] = i;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 460
diff changeset
1338 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 ccl_read_multibyte_character_suspend:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342 src--;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 if (ccl->last_block)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 ic = ccl->eof_ic;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346 goto ccl_repeat;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 case CCL_WriteMultibyteChar2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 i = reg[RRR]; /* charset */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 if (i == LEADING_BYTE_ASCII)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 i = reg[rrr] & 0xFF;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 else if (XCHARSET_DIMENSION (CHARSET_BY_LEADING_BYTE (i)) == 1)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1358 i = (((i - FIELD2_TO_OFFICIAL_LEADING_BYTE) << 7)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1359 | (reg[rrr] & 0x7F));
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1360 else if (i < MAX_LEADING_BYTE_OFFICIAL_2)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 i = ((i - FIELD1_TO_OFFICIAL_LEADING_BYTE) << 14) | reg[rrr];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 i = ((i - FIELD1_TO_PRIVATE_LEADING_BYTE) << 14) | reg[rrr];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 CCL_WRITE_CHAR (i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1369 case CCL_TranslateCharacter:
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 #if 0
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1371 /* XEmacs does not have translate_char, and its
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1372 equivalent nor. We do nothing on this operation. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1373 CCL_MAKE_CHAR (reg[RRR], reg[rrr], i);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374 op = translate_char (GET_TRANSLATION_TABLE (reg[Rrr]),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 i, -1, 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 SPLIT_CHAR (op, reg[RRR], i, j);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 if (j != -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 i = (i << 7) | j;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1379
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 reg[rrr] = i;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1381 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 case CCL_TranslateCharacterConstTbl:
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1385 #if 0
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1386 /* XEmacs does not have translate_char, and its
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1387 equivalent nor. We do nothing on this operation. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388 op = XINT (ccl_prog[ic]); /* table */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389 ic++;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1390 CCL_MAKE_CHAR (reg[RRR], reg[rrr], i);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 op = translate_char (GET_TRANSLATION_TABLE (op), i, -1, 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392 SPLIT_CHAR (op, reg[RRR], i, j);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393 if (j != -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 i = (i << 7) | j;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1395
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396 reg[rrr] = i;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1397 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 case CCL_IterateMultipleMap:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 Lisp_Object map, content, attrib, value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403 int point, size, fin_ic;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 j = XINT (ccl_prog[ic++]); /* number of maps. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 fin_ic = ic + j;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407 op = reg[rrr];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408 if ((j > reg[RRR]) && (j >= 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 ic += reg[RRR];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411 i = reg[RRR];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415 reg[RRR] = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 ic = fin_ic;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420 for (;i < j;i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423 size = XVECTOR (Vcode_conversion_map_vector)->size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 point = XINT (ccl_prog[ic++]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 if (point >= size) continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 map =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 XVECTOR (Vcode_conversion_map_vector)->contents[point];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1429 /* Check map validity. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 if (!CONSP (map)) continue;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1431 map = XCDR (map);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432 if (!VECTORP (map)) continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 size = XVECTOR (map)->size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434 if (size <= 1) continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 content = XVECTOR (map)->contents[0];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438 /* check map type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 [STARTPOINT VAL1 VAL2 ...] or
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1440 [t ELEMENT STARTPOINT ENDPOINT] */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1441 if (INTP (content))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 point = XUINT (content);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 point = op - point + 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445 if (!((point >= 1) && (point < size))) continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 content = XVECTOR (map)->contents[point];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 else if (EQ (content, Qt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450 if (size != 4) continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 if ((op >= XUINT (XVECTOR (map)->contents[2]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 && (op < XUINT (XVECTOR (map)->contents[3])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453 content = XVECTOR (map)->contents[1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1457 else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 if (NILP (content))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 continue;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1462 else if (INTP (content))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 reg[RRR] = i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 reg[rrr] = XINT(content);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468 else if (EQ (content, Qt) || EQ (content, Qlambda))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470 reg[RRR] = i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 else if (CONSP (content))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1475 attrib = XCAR (content);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1476 value = XCDR (content);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1477 if (!INTP (attrib) || !INTP (value))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479 reg[RRR] = i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 reg[rrr] = XUINT (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482 }
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1483 else if (SYMBOLP (content))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1484 CCL_CALL_FOR_MAP_INSTRUCTION (content, fin_ic);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1485 else
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1486 CCL_INVALID_CMD;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1488 if (i == j)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489 reg[RRR] = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490 ic = fin_ic;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1491 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1492 break;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1493
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494 case CCL_MapMultiple:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 Lisp_Object map, content, attrib, value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 int point, size, map_vector_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498 int map_set_rest_length, fin_ic;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1499 int current_ic = this_ic;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1500
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1501 /* inhibit recursive call on MapMultiple. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1502 if (stack_idx_of_map_multiple > 0)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1503 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1504 if (stack_idx_of_map_multiple <= stack_idx)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1505 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1506 stack_idx_of_map_multiple = 0;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1507 mapping_stack_pointer = mapping_stack;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1508 CCL_INVALID_CMD;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1509 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1510 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1511 else
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1512 mapping_stack_pointer = mapping_stack;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1513 stack_idx_of_map_multiple = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1514
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 map_set_rest_length =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516 XINT (ccl_prog[ic++]); /* number of maps and separators. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517 fin_ic = ic + map_set_rest_length;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1518 op = reg[rrr];
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1519
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1520 if ((map_set_rest_length > reg[RRR]) && (reg[RRR] >= 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522 ic += reg[RRR];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 i = reg[RRR];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524 map_set_rest_length -= i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528 ic = fin_ic;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529 reg[RRR] = -1;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1530 mapping_stack_pointer = mapping_stack;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1531 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 }
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1533
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1534 if (mapping_stack_pointer <= (mapping_stack + 1))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1536 /* Set up initial state. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1537 mapping_stack_pointer = mapping_stack;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1538 PUSH_MAPPING_STACK (0, op);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1539 reg[RRR] = -1;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1540 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1541 else
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1542 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1543 /* Recover after calling other ccl program. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1544 int orig_op;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1545
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1546 POP_MAPPING_STACK (map_set_rest_length, orig_op);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1547 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1548 switch (op)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1550 case -1:
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1551 /* Regard it as Qnil. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1552 op = orig_op;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1553 i++;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1554 ic++;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1555 map_set_rest_length--;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1556 break;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1557 case -2:
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1558 /* Regard it as Qt. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1559 op = reg[rrr];
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1560 i++;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1561 ic++;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1562 map_set_rest_length--;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1563 break;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1564 case -3:
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1565 /* Regard it as Qlambda. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1566 op = orig_op;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1567 i += map_set_rest_length;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1568 ic += map_set_rest_length;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1569 map_set_rest_length = 0;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1570 break;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1571 default:
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1572 /* Regard it as normal mapping. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573 i += map_set_rest_length;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1574 ic += map_set_rest_length;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578 }
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1579 map_vector_size = XVECTOR (Vcode_conversion_map_vector)->size;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1580
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1581 do {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1582 for (;map_set_rest_length > 0;i++, ic++, map_set_rest_length--)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1583 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1584 point = XINT(ccl_prog[ic]);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1585 if (point < 0)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1586 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1587 /* +1 is for including separator. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1588 point = -point + 1;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1589 if (mapping_stack_pointer
460
223736d75acb Import from CVS: tag r21-2-45
cvs
parents: 456
diff changeset
1590 >= mapping_stack + countof (mapping_stack))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1591 CCL_INVALID_CMD;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1592 PUSH_MAPPING_STACK (map_set_rest_length - point,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1593 reg[rrr]);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1594 map_set_rest_length = point;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1595 reg[rrr] = op;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1596 continue;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1597 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1598
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1599 if (point >= map_vector_size) continue;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1600 map = (XVECTOR (Vcode_conversion_map_vector)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1601 ->contents[point]);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1602
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1603 /* Check map validity. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1604 if (!CONSP (map)) continue;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1605 map = XCDR (map);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1606 if (!VECTORP (map)) continue;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1607 size = XVECTOR (map)->size;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1608 if (size <= 1) continue;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1609
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1610 content = XVECTOR (map)->contents[0];
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1611
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1612 /* check map type,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1613 [STARTPOINT VAL1 VAL2 ...] or
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1614 [t ELEMENT STARTPOINT ENDPOINT] */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1615 if (INTP (content))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1616 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1617 point = XUINT (content);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1618 point = op - point + 1;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1619 if (!((point >= 1) && (point < size))) continue;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1620 content = XVECTOR (map)->contents[point];
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1621 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1622 else if (EQ (content, Qt))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1623 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1624 if (size != 4) continue;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1625 if ((op >= XUINT (XVECTOR (map)->contents[2])) &&
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1626 (op < XUINT (XVECTOR (map)->contents[3])))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1627 content = XVECTOR (map)->contents[1];
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1628 else
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1629 continue;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1630 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1631 else
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1632 continue;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1633
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1634 if (NILP (content))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1635 continue;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1636
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1637 reg[RRR] = i;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1638 if (INTP (content))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1639 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1640 op = XINT (content);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1641 i += map_set_rest_length - 1;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1642 ic += map_set_rest_length - 1;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1643 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1644 map_set_rest_length++;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1645 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1646 else if (CONSP (content))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1647 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1648 attrib = XCAR (content);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1649 value = XCDR (content);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1650 if (!INTP (attrib) || !INTP (value))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1651 continue;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1652 op = XUINT (value);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1653 i += map_set_rest_length - 1;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1654 ic += map_set_rest_length - 1;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1655 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1656 map_set_rest_length++;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1657 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1658 else if (EQ (content, Qt))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1659 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1660 op = reg[rrr];
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1661 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1662 else if (EQ (content, Qlambda))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1663 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1664 i += map_set_rest_length;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1665 ic += map_set_rest_length;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1666 break;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1667 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1668 else if (SYMBOLP (content))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1669 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1670 if (mapping_stack_pointer
460
223736d75acb Import from CVS: tag r21-2-45
cvs
parents: 456
diff changeset
1671 >= mapping_stack + countof (mapping_stack))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1672 CCL_INVALID_CMD;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1673 PUSH_MAPPING_STACK (map_set_rest_length, reg[rrr]);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1674 PUSH_MAPPING_STACK (map_set_rest_length, op);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1675 stack_idx_of_map_multiple = stack_idx + 1;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1676 CCL_CALL_FOR_MAP_INSTRUCTION (content, current_ic);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1677 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1678 else
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1679 CCL_INVALID_CMD;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1680 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1681 if (mapping_stack_pointer <= (mapping_stack + 1))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1682 break;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1683 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1684 i += map_set_rest_length;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1685 ic += map_set_rest_length;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1686 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1687 } while (1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1688
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 ic = fin_ic;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691 reg[rrr] = op;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694 case CCL_MapSingle:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1695 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1696 Lisp_Object map, attrib, value, content;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697 int size, point;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698 j = XINT (ccl_prog[ic++]); /* map_id */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699 op = reg[rrr];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1700 if (j >= XVECTOR (Vcode_conversion_map_vector)->size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1701 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1702 reg[RRR] = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1703 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1704 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1705 map = XVECTOR (Vcode_conversion_map_vector)->contents[j];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1706 if (!CONSP (map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1707 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1708 reg[RRR] = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710 }
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1711 map = XCDR (map);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1712 if (!VECTORP (map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1713 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1714 reg[RRR] = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1715 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1716 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1717 size = XVECTOR (map)->size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1718 point = XUINT (XVECTOR (map)->contents[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1719 point = op - point + 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1720 reg[RRR] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1721 if ((size <= 1) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1722 (!((point >= 1) && (point < size))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1723 reg[RRR] = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1724 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1725 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1726 reg[RRR] = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1727 content = XVECTOR (map)->contents[point];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1728 if (NILP (content))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1729 reg[RRR] = -1;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1730 else if (INTP (content))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1731 reg[rrr] = XINT (content);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1732 else if (EQ (content, Qt));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1733 else if (CONSP (content))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1734 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1735 attrib = XCAR (content);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1736 value = XCDR (content);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1737 if (!INTP (attrib) || !INTP (value))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1738 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1739 reg[rrr] = XUINT(value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1740 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1741 }
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1742 else if (SYMBOLP (content))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1743 CCL_CALL_FOR_MAP_INSTRUCTION (content, ic);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1744 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745 reg[RRR] = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1746 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1747 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1748 break;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1749
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1750 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751 CCL_INVALID_CMD;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1752 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1753 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1754
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755 default:
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1756 CCL_INVALID_CMD;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1757 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1758 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760 ccl_error_handler:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761 if (destination)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1762 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1763 /* We can insert an error message only if DESTINATION is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1764 specified and we still have a room to store the message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1765 there. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766 char msg[256];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1768 switch (ccl->status)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1769 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1770 case CCL_STAT_INVALID_CMD:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1771 sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772 code & 0x1F, code, this_ic);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773 #ifdef CCL_DEBUG
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775 int i = ccl_backtrace_idx - 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776 int j;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1779
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780 for (j = 0; j < CCL_DEBUG_BACKTRACE_LEN; j++, i--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1782 if (i < 0) i = CCL_DEBUG_BACKTRACE_LEN - 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1783 if (ccl_backtrace_table[i] == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1784 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1785 sprintf(msg, " %d", ccl_backtrace_table[i]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1786 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1787 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788 goto ccl_finish;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1789 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1790 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793 case CCL_STAT_QUIT:
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1794 sprintf(msg, "\nCCL: Exited.");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1796
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798 sprintf(msg, "\nCCL: Unknown error type (%d).", ccl->status);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1802 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1803
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804 ccl_finish:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 ccl->ic = ic;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806 ccl->stack_idx = stack_idx;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 ccl->prog = ccl_prog;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808 if (consumed) *consumed = src - source;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1809 if (!destination)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810 return 0;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1811 return Dynarr_length (destination);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1812 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1813
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1814 /* Resolve symbols in the specified CCL code (Lisp vector). This
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1815 function converts symbols of code conversion maps and character
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1816 translation tables embedded in the CCL code into their ID numbers.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1817
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1818 The return value is a vector (CCL itself or a new vector in which
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1819 all symbols are resolved), Qt if resolving of some symbol failed,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1820 or nil if CCL contains invalid data. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1821
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1822 static Lisp_Object
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1823 resolve_symbol_ccl_program (Lisp_Object ccl)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1824 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1825 int i, veclen, unresolved = 0;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1826 Lisp_Object result, contents, val;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1827
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1828 result = ccl;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1829 veclen = XVECTOR (result)->size;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1830
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1831 for (i = 0; i < veclen; i++)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1832 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1833 contents = XVECTOR (result)->contents[i];
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1834 if (INTP (contents))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1835 continue;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1836 else if (CONSP (contents)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1837 && SYMBOLP (XCAR (contents))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1838 && SYMBOLP (XCDR (contents)))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1839 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1840 /* This is the new style for embedding symbols. The form is
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1841 (SYMBOL . PROPERTY). (get SYMBOL PROPERTY) should give
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1842 an index number. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1843
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1844 if (EQ (result, ccl))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1845 result = Fcopy_sequence (ccl);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1846
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1847 val = Fget (XCAR (contents), XCDR (contents), Qnil);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1848 if (NATNUMP (val))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1849 XVECTOR (result)->contents[i] = val;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1850 else
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1851 unresolved = 1;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1852 continue;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1853 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1854 else if (SYMBOLP (contents))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1855 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1856 /* This is the old style for embedding symbols. This style
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1857 may lead to a bug if, for instance, a translation table
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1858 and a code conversion map have the same name. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1859 if (EQ (result, ccl))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1860 result = Fcopy_sequence (ccl);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1861
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1862 val = Fget (contents, Qcode_conversion_map_id, Qnil);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1863 if (NATNUMP (val))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1864 XVECTOR (result)->contents[i] = val;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1865 else
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1866 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1867 val = Fget (contents, Qccl_program_idx, Qnil);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1868 if (NATNUMP (val))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1869 XVECTOR (result)->contents[i] = val;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1870 else
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1871 unresolved = 1;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1872 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1873 continue;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1874 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1875 return Qnil;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1876 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1877
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1878 return (unresolved ? Qt : result);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1879 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1880
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1881 /* Return the compiled code (vector) of CCL program CCL_PROG.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1882 CCL_PROG is a name (symbol) of the program or already compiled
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1883 code. If necessary, resolve symbols in the compiled code to index
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1884 numbers. If we failed to get the compiled code or to resolve
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1885 symbols, return Qnil. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1886
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1887 static Lisp_Object
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1888 ccl_get_compiled_code (Lisp_Object ccl_prog)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1889 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1890 Lisp_Object val, slot;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1891
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1892 if (VECTORP (ccl_prog))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1893 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1894 val = resolve_symbol_ccl_program (ccl_prog);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1895 return (VECTORP (val) ? val : Qnil);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1896 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1897 if (!SYMBOLP (ccl_prog))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1898 return Qnil;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1899
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1900 val = Fget (ccl_prog, Qccl_program_idx, Qnil);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1901 if (! NATNUMP (val)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1902 || XINT (val) >= XVECTOR_LENGTH (Vccl_program_table))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1903 return Qnil;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1904 slot = XVECTOR_DATA (Vccl_program_table)[XINT (val)];
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1905 if (! VECTORP (slot)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1906 || XVECTOR (slot)->size != 3
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1907 || ! VECTORP (XVECTOR_DATA (slot)[1]))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1908 return Qnil;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1909 if (NILP (XVECTOR_DATA (slot)[2]))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1910 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1911 val = resolve_symbol_ccl_program (XVECTOR_DATA (slot)[1]);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1912 if (! VECTORP (val))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1913 return Qnil;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1914 XVECTOR_DATA (slot)[1] = val;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1915 XVECTOR_DATA (slot)[2] = Qt;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1916 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1917 return XVECTOR_DATA (slot)[1];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1919
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1920 /* Setup fields of the structure pointed by CCL appropriately for the
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1921 execution of CCL program CCL_PROG. CCL_PROG is the name (symbol)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1922 of the CCL program or the already compiled code (vector).
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1923 Return 0 if we succeed this setup, else return -1.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1924
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1925 If CCL_PROG is nil, we just reset the structure pointed by CCL. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1926 int
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1927 setup_ccl_program (struct ccl_program *ccl, Lisp_Object ccl_prog)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1930
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1931 if (! NILP (ccl_prog))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1932 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1933 ccl_prog = ccl_get_compiled_code (ccl_prog);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1934 if (! VECTORP (ccl_prog))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1935 return -1;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1936 ccl->size = XVECTOR_LENGTH (ccl_prog);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1937 ccl->prog = XVECTOR_DATA (ccl_prog);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1938 ccl->eof_ic = XINT (XVECTOR_DATA (ccl_prog)[CCL_HEADER_EOF]);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1939 ccl->buf_magnification = XINT (XVECTOR_DATA (ccl_prog)[CCL_HEADER_BUF_MAG]);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1940 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941 ccl->ic = CCL_HEADER_MAIN;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1942 for (i = 0; i < 8; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1943 ccl->reg[i] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1944 ccl->last_block = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1945 ccl->private_state = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1946 ccl->status = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1947 ccl->stack_idx = 0;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1948 ccl->eol_type = CCL_CODING_EOL_LF;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1949 return 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1950 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1951
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1952 #ifdef emacs
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1953
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1954 DEFUN ("ccl-program-p", Fccl_program_p, 1, 1, 0, /*
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1955 Return t if OBJECT is a CCL program name or a compiled CCL program code.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1956 See the documentation of `define-ccl-program' for the detail of CCL program.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1957 */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1958 (object))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1959 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1960 Lisp_Object val;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1961
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1962 if (VECTORP (object))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1963 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1964 val = resolve_symbol_ccl_program (object);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1965 return (VECTORP (val) ? Qt : Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1966 }
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1967 if (!SYMBOLP (object))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1968 return Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1969
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1970 val = Fget (object, Qccl_program_idx, Qnil);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1971 return ((! NATNUMP (val)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1972 || XINT (val) >= XVECTOR_LENGTH (Vccl_program_table))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1973 ? Qnil : Qt);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1974 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1975
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1976 DEFUN ("ccl-execute", Fccl_execute, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1977 Execute CCL-PROGRAM with registers initialized by REGISTERS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1978
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1979 CCL-PROGRAM is a CCL program name (symbol)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1980 or a compiled code generated by `ccl-compile' (for backward compatibility,
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1981 in this case, the overhead of the execution is bigger than the former case).
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1982 No I/O commands should appear in CCL-PROGRAM.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1983
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1984 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1985 of Nth register.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1986
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1987 As side effect, each element of REGISTERS holds the value of
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1988 corresponding register after the execution.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1989
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1990 See the documentation of `define-ccl-program' for the detail of CCL program.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1991 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1992 (ccl_prog, reg))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1993 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1994 struct ccl_program ccl;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1995 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1996
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1997 if (setup_ccl_program (&ccl, ccl_prog) < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
1998 syntax_error ("Invalid CCL program", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1999
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2000 CHECK_VECTOR (reg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2001 if (XVECTOR_LENGTH (reg) != 8)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
2002 syntax_error ("Length of vector REGISTERS is not 8", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2003
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2004 for (i = 0; i < 8; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005 ccl.reg[i] = (INTP (XVECTOR_DATA (reg)[i])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2006 ? XINT (XVECTOR_DATA (reg)[i])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2007 : 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2009 ccl_driver (&ccl, (const unsigned char *)0,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2010 (unsigned_char_dynarr *)0, 0, (int *)0,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2011 CCL_MODE_ENCODING);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2012 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013 if (ccl.status != CCL_STAT_SUCCESS)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
2014 signal_error (Qccl_error, "Error in CCL program at code numbered ...", make_int (ccl.ic));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2015
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2016 for (i = 0; i < 8; i++)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2017 XSETINT (XVECTOR (reg)->contents[i], ccl.reg[i]);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2018 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2019 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2020
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2021 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2022 3, 4, 0, /*
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2023 Execute CCL-PROGRAM with initial STATUS on STRING.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2025 CCL-PROGRAM is a symbol registered by register-ccl-program,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2026 or a compiled code generated by `ccl-compile' (for backward compatibility,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2027 in this case, the execution is slower).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2028
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2029 Read buffer is set to STRING, and write buffer is allocated automatically.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2030
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2031 STATUS is a vector of [R0 R1 ... R7 IC], where
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2032 R0..R7 are initial values of corresponding registers,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2033 IC is the instruction counter specifying from where to start the program.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2034 If R0..R7 are nil, they are initialized to 0.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2035 If IC is nil, it is initialized to head of the CCL program.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2036
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2037 If optional 4th arg CONTINUE is non-nil, keep IC on read operation
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2038 when read buffer is exhausted, else, IC is always set to the end of
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2039 CCL-PROGRAM on exit.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2040
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2041 It returns the contents of write buffer as a string,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2042 and as side effect, STATUS is updated.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2043
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2044 See the documentation of `define-ccl-program' for the detail of CCL program.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2045 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2046 (ccl_prog, status, string, continue_))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2047 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2048 Lisp_Object val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2049 struct ccl_program ccl;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2050 int i, produced;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2051 unsigned_char_dynarr *outbuf;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2052 struct gcpro gcpro1, gcpro2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2053
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2054 if (setup_ccl_program (&ccl, ccl_prog) < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
2055 syntax_error ("Invalid CCL program", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2056
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2057 CHECK_VECTOR (status);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2058 if (XVECTOR (status)->size != 9)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
2059 syntax_error ("Length of vector STATUS is not 9", Qunbound);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2060 CHECK_STRING (string);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2061
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2062 GCPRO2 (status, string);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2063
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2064 for (i = 0; i < 8; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2065 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2066 if (NILP (XVECTOR_DATA (status)[i]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2067 XSETINT (XVECTOR_DATA (status)[i], 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2068 if (INTP (XVECTOR_DATA (status)[i]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2069 ccl.reg[i] = XINT (XVECTOR_DATA (status)[i]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2070 }
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2071 if (INTP (XVECTOR (status)->contents[i]))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2072 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2073 i = XINT (XVECTOR_DATA (status)[8]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2074 if (ccl.ic < i && i < ccl.size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2075 ccl.ic = i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2076 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2077 outbuf = Dynarr_new (unsigned_char);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2078 ccl.last_block = NILP (continue_);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2079 produced = ccl_driver (&ccl, XSTRING_DATA (string), outbuf,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2080 XSTRING_LENGTH (string),
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2081 (int *) 0,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2082 CCL_MODE_DECODING);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2083 for (i = 0; i < 8; i++)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2084 XSETINT (XVECTOR_DATA (status)[i], ccl.reg[i]);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2085 XSETINT (XVECTOR_DATA (status)[8], ccl.ic);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2086 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2087
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2088 val = make_string (Dynarr_atp (outbuf, 0), produced);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2089 Dynarr_free (outbuf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2090 QUIT;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2091 if (ccl.status == CCL_STAT_SUSPEND_BY_DST)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
2092 signal_error (Qccl_error, "Output buffer for the CCL programs overflow", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2093 if (ccl.status != CCL_STAT_SUCCESS
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2094 && ccl.status != CCL_STAT_SUSPEND_BY_SRC)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
2095 signal_error (Qccl_error, "Error in CCL program at code numbered...", make_int (ccl.ic));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2096
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2097 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2098 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2099
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2100 DEFUN ("register-ccl-program", Fregister_ccl_program,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2101 2, 2, 0, /*
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2102 Register CCL program CCL-PROG as NAME in `ccl-program-table'.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2103 CCL-PROG should be a compiled CCL program (vector), or nil.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2104 If it is nil, just reserve NAME as a CCL program name.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2105 Return index number of the registered CCL program.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2106 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2107 (name, ccl_prog))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2108 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2109 int len = XVECTOR_LENGTH (Vccl_program_table);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2110 int idx;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2111 Lisp_Object resolved;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2112
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2113 CHECK_SYMBOL (name);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2114 resolved = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2115 if (!NILP (ccl_prog))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2116 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2117 CHECK_VECTOR (ccl_prog);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2118 resolved = resolve_symbol_ccl_program (ccl_prog);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2119 if (! NILP (resolved))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2120 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2121 ccl_prog = resolved;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2122 resolved = Qt;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2123 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2124 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2125
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2126 for (idx = 0; idx < len; idx++)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2127 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2128 Lisp_Object slot;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2129
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2130 slot = XVECTOR_DATA (Vccl_program_table)[idx];
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2131 if (!VECTORP (slot))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2132 /* This is the first unused slot. Register NAME here. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2133 break;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2134
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2135 if (EQ (name, XVECTOR_DATA (slot)[0]))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2136 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2137 /* Update this slot. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2138 XVECTOR_DATA (slot)[1] = ccl_prog;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2139 XVECTOR_DATA (slot)[2] = resolved;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2140 return make_int (idx);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2141 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2142 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2143
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2144 if (idx == len)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2145 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2146 /* Extend the table. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2147 Lisp_Object new_table;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2148 int j;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2149
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2150 new_table = Fmake_vector (make_int (len * 2), Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2151 for (j = 0; j < len; j++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2152 XVECTOR_DATA (new_table)[j]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2153 = XVECTOR_DATA (Vccl_program_table)[j];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2154 Vccl_program_table = new_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2155 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2156
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2157 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2158 Lisp_Object elt;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2159
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2160 elt = Fmake_vector (make_int (3), Qnil);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2161 XVECTOR_DATA (elt)[0] = name;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2162 XVECTOR_DATA (elt)[1] = ccl_prog;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2163 XVECTOR_DATA (elt)[2] = resolved;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2164 XVECTOR_DATA (Vccl_program_table)[idx] = elt;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2165 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2166
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2167 Fput (name, Qccl_program_idx, make_int (idx));
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2168 return make_int (idx);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2169 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2170
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2171 /* Register code conversion map.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2172 A code conversion map consists of numbers, Qt, Qnil, and Qlambda.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2173 The first element is start code point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2174 The rest elements are mapped numbers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2175 Symbol t means to map to an original number before mapping.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2176 Symbol nil means that the corresponding element is empty.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2177 Symbol lambda means to terminate mapping here.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2178 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2179
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2180 DEFUN ("register-code-conversion-map", Fregister_code_conversion_map,
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2181 2, 2, 0, /*
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2182 Register SYMBOL as code conversion map MAP.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2183 Return index number of the registered map.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2184 */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2185 (symbol, map))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2186 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2187 int len = XVECTOR_LENGTH (Vcode_conversion_map_vector);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2188 int i;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2189 Lisp_Object idx;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2190
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2191 CHECK_SYMBOL (symbol);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2192 CHECK_VECTOR (map);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2193
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2194 for (i = 0; i < len; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2195 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2196 Lisp_Object slot = XVECTOR_DATA (Vcode_conversion_map_vector)[i];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2197
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2198 if (!CONSP (slot))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2199 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2200
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2201 if (EQ (symbol, XCAR (slot)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2202 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2203 idx = make_int (i);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2204 XCDR (slot) = map;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2205 Fput (symbol, Qcode_conversion_map, map);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2206 Fput (symbol, Qcode_conversion_map_id, idx);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2207 return idx;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2208 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2209 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2210
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2211 if (i == len)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2212 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2213 Lisp_Object new_vector = Fmake_vector (make_int (len * 2), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2214 int j;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2215
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2216 for (j = 0; j < len; j++)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2217 XVECTOR_DATA (new_vector)[j]
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2218 = XVECTOR_DATA (Vcode_conversion_map_vector)[j];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2219 Vcode_conversion_map_vector = new_vector;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2220 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2221
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2222 idx = make_int (i);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2223 Fput (symbol, Qcode_conversion_map, map);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2224 Fput (symbol, Qcode_conversion_map_id, idx);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2225 XVECTOR_DATA (Vcode_conversion_map_vector)[i] = Fcons (symbol, map);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2226 return idx;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2227 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2228
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2229
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2230 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2231 syms_of_mule_ccl (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2232 {
565
e9162e1ea200 [xemacs-hg @ 2001-05-24 09:53:05 by yoshiki]
yoshiki
parents: 563
diff changeset
2233 DEFERROR_STANDARD (Qccl_error, Qconversion_error);
e9162e1ea200 [xemacs-hg @ 2001-05-24 09:53:05 by yoshiki]
yoshiki
parents: 563
diff changeset
2234
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2235 DEFSUBR (Fccl_program_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2236 DEFSUBR (Fccl_execute);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2237 DEFSUBR (Fccl_execute_on_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2238 DEFSUBR (Fregister_ccl_program);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2239 DEFSUBR (Fregister_code_conversion_map);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2240 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2241
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2242 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2243 vars_of_mule_ccl (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2244 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2245 staticpro (&Vccl_program_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2246 Vccl_program_table = Fmake_vector (make_int (32), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2247
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
2248 DEFSYMBOL (Qccl_program);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
2249 DEFSYMBOL (Qccl_program_idx);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
2250 DEFSYMBOL (Qcode_conversion_map);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
2251 DEFSYMBOL (Qcode_conversion_map_id);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2252
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2253 DEFVAR_LISP ("code-conversion-map-vector", &Vcode_conversion_map_vector /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2254 Vector of code conversion maps.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2255 */ );
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2256 Vcode_conversion_map_vector = Fmake_vector (make_int (16), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2257
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2258 DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2259 Alist of fontname patterns vs corresponding CCL program.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2260 Each element looks like (REGEXP . CCL-CODE),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2261 where CCL-CODE is a compiled CCL program.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2262 When a font whose name matches REGEXP is used for displaying a character,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2263 CCL-CODE is executed to calculate the code point in the font
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2264 from the charset number and position code(s) of the character which are set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2265 in CCL registers R0, R1, and R2 before the execution.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2266 The code point in the font is set in CCL registers R1 and R2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2267 when the execution terminated.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2268 If the font is single-byte font, the register R2 is not used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2269 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2270 Vfont_ccl_encoder_alist = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2271 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2272
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2273 #endif /* emacs */