| 2 |
7u83 |
1 |
/*
|
|
|
2 |
Crown Copyright (c) 1997, 1998
|
|
|
3 |
|
|
|
4 |
This TenDRA(r) Computer Program is subject to Copyright
|
|
|
5 |
owned by the United Kingdom Secretary of State for Defence
|
|
|
6 |
acting through the Defence Evaluation and Research Agency
|
|
|
7 |
(DERA). It is made available to Recipients with a
|
|
|
8 |
royalty-free licence for its use, reproduction, transfer
|
|
|
9 |
to other parties and amendment for any purpose not excluding
|
|
|
10 |
product development provided that any such use et cetera
|
|
|
11 |
shall be deemed to be acceptance of the following conditions:-
|
|
|
12 |
|
|
|
13 |
(1) Its Recipients shall ensure that this Notice is
|
|
|
14 |
reproduced upon any copies or amended versions of it;
|
|
|
15 |
|
|
|
16 |
(2) Any amended version of it shall be clearly marked to
|
|
|
17 |
show both the nature of and the organisation responsible
|
|
|
18 |
for the relevant amendment or amendments;
|
|
|
19 |
|
|
|
20 |
(3) Its onward transfer from a recipient to another
|
|
|
21 |
party shall be deemed to be that party's acceptance of
|
|
|
22 |
these conditions;
|
|
|
23 |
|
|
|
24 |
(4) DERA gives no warranty or assurance as to its
|
|
|
25 |
quality or suitability for any purpose and DERA accepts
|
|
|
26 |
no liability whatsoever in relation to any use to which
|
|
|
27 |
it may be put.
|
|
|
28 |
*/
|
|
|
29 |
|
|
|
30 |
|
|
|
31 |
#include "config.h"
|
|
|
32 |
#include "version.h"
|
|
|
33 |
#include "c_types.h"
|
|
|
34 |
#include "exp_ops.h"
|
|
|
35 |
#include "hashid_ops.h"
|
|
|
36 |
#include "id_ops.h"
|
|
|
37 |
#include "member_ops.h"
|
|
|
38 |
#include "str_ops.h"
|
|
|
39 |
#include "tok_ops.h"
|
|
|
40 |
#include "type_ops.h"
|
|
|
41 |
#include "error.h"
|
|
|
42 |
#include "catalog.h"
|
|
|
43 |
#include "option.h"
|
|
|
44 |
#include "tdf.h"
|
|
|
45 |
#include "basetype.h"
|
|
|
46 |
#include "capsule.h"
|
|
|
47 |
#include "compile.h"
|
|
|
48 |
#include "diag.h"
|
|
|
49 |
#include "encode.h"
|
|
|
50 |
#include "exp.h"
|
|
|
51 |
#include "hash.h"
|
|
|
52 |
#include "interface.h"
|
|
|
53 |
#include "namespace.h"
|
|
|
54 |
#include "preproc.h"
|
|
|
55 |
#include "shape.h"
|
|
|
56 |
#include "statement.h"
|
|
|
57 |
#include "stmt.h"
|
|
|
58 |
#include "struct.h"
|
|
|
59 |
#include "syntax.h"
|
|
|
60 |
#include "tok.h"
|
|
|
61 |
#include "token.h"
|
|
|
62 |
#include "ustring.h"
|
|
|
63 |
|
|
|
64 |
|
|
|
65 |
/*
|
|
|
66 |
TABLE OF SPECIAL TOKENS
|
|
|
67 |
|
|
|
68 |
This table gives the name, the parameter and result sorts, and external
|
|
|
69 |
(capsule) number for the various special tokens used in the output.
|
|
|
70 |
Each special token may have an associated externally declared token
|
|
|
71 |
identifier. The entries in this table correspond to the TOK values
|
|
|
72 |
defined in tok.h.
|
|
|
73 |
*/
|
|
|
74 |
|
|
|
75 |
static struct {
|
|
|
76 |
CONST char *name ;
|
|
|
77 |
CONST char *sorts ;
|
|
|
78 |
ulong no ;
|
|
|
79 |
ulong diag ;
|
|
|
80 |
IDENTIFIER tok ;
|
|
|
81 |
int builtin ;
|
|
|
82 |
} special_token [ TOK_no ] = {
|
|
|
83 |
/* Built-in integral types */
|
|
|
84 |
{ "~char", "V", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
85 |
{ "~signed_char", "V", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
86 |
{ "~unsigned_char", "V", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
87 |
{ "~signed_short", "V", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
88 |
{ "~unsigned_short", "V", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
89 |
{ "~signed_int", "V", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
90 |
{ "~unsigned_int", "V", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
91 |
{ "~signed_long", "V", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
92 |
{ "~unsigned_long", "V", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
93 |
{ "~signed_longlong", "V", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
94 |
{ "~unsigned_longlong", "V", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
95 |
|
|
|
96 |
/* Built-in floating-point types */
|
|
|
97 |
{ "~float", "F", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
98 |
{ "~double", "F", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
99 |
{ "~long_double", "F", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
100 |
|
|
|
101 |
/* Standard integral types */
|
|
|
102 |
{ "~cpp.bool", "Z", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
103 |
{ "ptrdiff_t", "Z", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
104 |
{ "size_t", "Z", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
105 |
{ "__size_t", "Z", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
106 |
{ "wchar_t", "Z", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
107 |
|
|
|
108 |
/* Integral type conversions */
|
|
|
109 |
{ "~convert", "VZ", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
110 |
{ "~arith_type", "ZZZ", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
111 |
{ "~promote", "ZZ", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
112 |
{ "~sign_promote", "ZZ", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
113 |
|
|
|
114 |
/* Integer literal types */
|
|
|
115 |
{ "~lit_int", "ZZ", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
116 |
{ "~lit_hex", "ZZ", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
117 |
{ "~lit_unsigned", "ZZ", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
118 |
{ "~lit_long", "ZZ", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
119 |
{ "~lit_ulong", "ZZ", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
120 |
{ "~lit_longlong", "ZZ", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
121 |
{ "~lit_ulonglong", "ZZ", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
122 |
|
|
|
123 |
/* Bitfield types */
|
|
|
124 |
{ "~cpp.bitf_sign", "BZ", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
125 |
|
|
|
126 |
/* Generic pointers */
|
|
|
127 |
{ "~ptr_void", "S", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
128 |
{ "~null_pv", "E", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
129 |
{ "~to_ptr_void", "EAE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
130 |
{ "~from_ptr_void", "EAE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
131 |
{ "~pv_test", "EELT", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
132 |
{ "~cpp.pv_compare", "EEELT", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
133 |
|
|
|
134 |
/* Undefined conversions */
|
|
|
135 |
{ "~ptr_to_ptr", "EAAE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
136 |
{ "~f_to_pv", "EE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
137 |
{ "~pv_to_f", "EE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
138 |
{ "~i_to_p", "EVAE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
139 |
{ "~p_to_i", "EAVE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
140 |
{ "~i_to_pv", "EVE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
141 |
{ "~pv_to_i", "EVE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
142 |
{ "~cpp.ptr_rep", "Z", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
143 |
|
|
|
144 |
/* Integer division */
|
|
|
145 |
{ "~div", "EEE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
146 |
{ "~rem", "EEE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
147 |
|
|
|
148 |
/* Ellipsis functions */
|
|
|
149 |
{ "~__va_t", "S", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
150 |
|
|
|
151 |
/* Pointers to data members */
|
|
|
152 |
{ "~cpp.pm.type", "S", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
153 |
{ "~cpp.pm.make", "EE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
154 |
{ "~cpp.pm.null", "E", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
155 |
{ "~cpp.pm.offset", "EEA", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
156 |
{ "~cpp.pm.cast", "EEE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
157 |
{ "~cpp.pm.uncast", "EEE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
158 |
{ "~cpp.pm.test", "EELT", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
159 |
{ "~cpp.pm.compare", "EEELT", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
160 |
|
|
|
161 |
/* Pointers to function members */
|
|
|
162 |
{ "~cpp.pmf.type", "S", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
163 |
{ "~cpp.pmf.make", "EEEE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
164 |
{ "~cpp.pmf.vmake", "EZEEE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
165 |
{ "~cpp.pmf.null", "E", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
166 |
{ "~cpp.pmf.null2", "E", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
167 |
{ "~cpp.pmf.delta", "EAE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
168 |
{ "~cpp.pmf.func", "EE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
169 |
{ "~cpp.pmf.virt", "EEEA", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
170 |
{ "~cpp.pmf.cast", "EEEEE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
171 |
{ "~cpp.pmf.uncast", "EEEEE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
172 |
{ "~cpp.pmf.test", "EELT", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
173 |
{ "~cpp.pmf.compare", "EEELT", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
174 |
|
|
|
175 |
/* Class layout */
|
|
|
176 |
{ "~comp_off", "EE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
177 |
{ "~pad", "EESS", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
178 |
{ "~cpp.empty.align", "A", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
179 |
{ "~cpp.empty.shape", "S", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
180 |
{ "~cpp.empty.offset", "E", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
181 |
|
|
|
182 |
/* Virtual function tables */
|
|
|
183 |
{ "~cpp.vtab.type", "SN", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
184 |
{ "~cpp.vtab.diag", "S", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
185 |
{ "~cpp.vtab.make", "EEENE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
186 |
{ "~cpp.vtab.pure", "E", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
187 |
{ "~cpp.vtab.func", "EEZ", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
188 |
{ "~cpp.vtab.off", "EZ", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
189 |
|
|
|
190 |
/* Run-time type information */
|
|
|
191 |
{ "~cpp.typeid.type", "S", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
192 |
{ "~cpp.typeid.make", "EZEE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
193 |
{ "~cpp.typeid.basic", "EZ", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
194 |
{ "~cpp.typeid.ref", "EE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
195 |
{ "~cpp.baseid.type", "S", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
196 |
{ "~cpp.baseid.make", "EEEEZZ", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
197 |
{ "~cpp.dynam.cast", "EEE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
198 |
|
|
|
199 |
/* Dynamic initialisation */
|
|
|
200 |
{ "~cpp.destr.type", "S", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
201 |
{ "~cpp.destr.global", "EEEE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
202 |
{ "~cpp.destr.local", "EEEE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
203 |
{ "~cpp.destr.end", "EE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
204 |
{ "~cpp.destr.init", "E", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
205 |
{ "~cpp.destr.null", "E", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
206 |
{ "~cpp.destr.ptr", "EE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
207 |
{ "~cpp.start", "E", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
208 |
|
|
|
209 |
/* Exception handling */
|
|
|
210 |
{ "~cpp.try.type", "S", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
211 |
{ "~cpp.try.begin", "EEEE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
212 |
{ "~cpp.try.end", "EE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
213 |
{ "~cpp.except.alloc", "EE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
214 |
{ "~cpp.except.throw", "EEEE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
215 |
{ "~cpp.except.rethrow", "E", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
216 |
{ "~cpp.except.catch", "EE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
217 |
{ "~cpp.except.value", "E", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
218 |
{ "~cpp.except.caught", "E", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
219 |
{ "~cpp.except.end", "E", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
220 |
{ "~cpp.except.bad", "EZ", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
221 |
{ "~cpp.except.jump", "EEE", LINK_NONE, LINK_NONE, NULL_id, 1 },
|
|
|
222 |
{ "~cpp.ptr.code", "S", LINK_NONE, LINK_NONE, NULL_id, 1 },
|
|
|
223 |
{ "~cpp.ptr.frame", "S", LINK_NONE, LINK_NONE, NULL_id, 1 },
|
|
|
224 |
|
|
|
225 |
/* Assembler inserts */
|
|
|
226 |
{ "~asm_sequence", "EE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
227 |
{ "~asm", "EC", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
228 |
{ "~asm_exp_input", "EE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
229 |
{ "~asm_exp_output", "EE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
230 |
{ "~asm_exp_address", "EE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
231 |
|
|
|
232 |
/* Built-in shorthands */
|
|
|
233 |
{ "~cpp.char_offset", "E", LINK_NONE, LINK_NONE, NULL_id, 2 },
|
|
|
234 |
{ "~cpp.shape_offset", "ES", LINK_NONE, LINK_NONE, NULL_id, 2 },
|
|
|
235 |
{ "~cpp.extra_offset", "EAE", LINK_NONE, LINK_NONE, NULL_id, 2 },
|
|
|
236 |
{ "~cpp.down_cast", "EAEE", LINK_NONE, LINK_NONE, NULL_id, 2 },
|
|
|
237 |
{ "~cpp.destr_cast", "EAE", LINK_NONE, LINK_NONE, NULL_id, 2 },
|
|
|
238 |
{ "~cpp.destr_test", "EEL", LINK_NONE, LINK_NONE, NULL_id, 2 }
|
|
|
239 |
|
|
|
240 |
#if 0
|
|
|
241 |
/* Unused standard C tokens */
|
|
|
242 |
{ "~assign", "EEES", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
243 |
{ "~assign_vol", "EEES", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
244 |
{ "~char_lit", "EEZV", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
245 |
{ "~checked_plus", "EEE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
246 |
{ "~debug_exp", "ENE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
247 |
{ "~debug_scope", "ENNE", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
248 |
{ "~fn_scope", "EENN", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
249 |
{ "~int_promot", "Z", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
250 |
{ "~little_endian", "E", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
251 |
{ "~ptr_add", "EEES", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
252 |
{ "~ptr_sub", "EEES", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
253 |
{ "~sizeof", "ES", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
254 |
{ "~string_lit", "EEZV", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
255 |
{ "~wchar_lit", "EEZV", LINK_NONE, LINK_NONE, NULL_id, 0 },
|
|
|
256 |
#endif
|
|
|
257 |
} ;
|
|
|
258 |
|
|
|
259 |
|
|
|
260 |
/*
|
|
|
261 |
TABLE OF BASIC TYPE TOKENS
|
|
|
262 |
|
|
|
263 |
This table gives the mapping from built-in type numbers to external
|
|
|
264 |
token names.
|
|
|
265 |
*/
|
|
|
266 |
|
|
|
267 |
BASE_TOKEN base_token [ ORDER_ntype ] = {
|
|
|
268 |
{ 0, ARITH_error, ARITH_error }, /* ntype_none */
|
|
|
269 |
{ TOK_char, ARITH_char, ARITH_char }, /* ntype_char */
|
|
|
270 |
{ TOK_signed_char, ARITH_schar, ARITH_schar }, /* ntype_schar */
|
|
|
271 |
{ TOK_unsigned_char, ARITH_uchar, ARITH_uchar }, /* ntype_uchar */
|
|
|
272 |
{ TOK_signed_short, ARITH_sshort, ARITH_sshort }, /* ntype_sshort */
|
|
|
273 |
{ TOK_unsigned_short, ARITH_ushort, ARITH_ushort }, /* ntype_ushort */
|
|
|
274 |
{ TOK_signed_int, ARITH_sint, ARITH_sint }, /* ntype_sint */
|
|
|
275 |
{ TOK_unsigned_int, ARITH_uint, ARITH_uint }, /* ntype_uint */
|
|
|
276 |
{ TOK_signed_long, ARITH_slong, ARITH_slong }, /* ntype_slong */
|
|
|
277 |
{ TOK_unsigned_long, ARITH_ulong, ARITH_ulong }, /* ntype_ulong */
|
|
|
278 |
{ TOK_signed_llong, ARITH_sllong, ARITH_sllong }, /* ntype_sllong */
|
|
|
279 |
{ TOK_unsigned_llong, ARITH_ullong, ARITH_ullong }, /* ntype_ullong */
|
|
|
280 |
{ TOK_float, ARITH_float, ARITH_float }, /* ntype_float */
|
|
|
281 |
{ TOK_double, ARITH_double, ARITH_double }, /* ntype_double */
|
|
|
282 |
{ TOK_long_double, ARITH_ldouble, ARITH_ldouble }, /* ntype_ldouble */
|
|
|
283 |
{ 0, ARITH_void, ARITH_void }, /* ntype_void */
|
|
|
284 |
{ 0, ARITH_bottom, ARITH_void }, /* ntype_bottom */
|
|
|
285 |
{ TOK_bool, ARITH_none, ARITH_bool }, /* ntype_bool */
|
|
|
286 |
{ TOK_ptrdiff_t, ARITH_none, ARITH_ptrdiff_t }, /* ntype_ptrdiff_t */
|
|
|
287 |
{ TOK_size_t, ARITH_none, ARITH_size_t }, /* ntype_size_t */
|
|
|
288 |
{ TOK_wchar_t, ARITH_none, ARITH_wchar_t }, /* ntype_wchar_t */
|
|
|
289 |
{ 0, ARITH_ellipsis, ARITH_ellipsis } /* ntype_ellipsis */
|
|
|
290 |
} ;
|
|
|
291 |
|
|
|
292 |
|
|
|
293 |
/*
|
|
|
294 |
INITIALISE SPECIAL TOKENS
|
|
|
295 |
|
|
|
296 |
This routine initialises the special tokens. This consists of
|
|
|
297 |
marking certain tokens which are used but not defined in C as being
|
|
|
298 |
built-in.
|
|
|
299 |
*/
|
|
|
300 |
|
|
|
301 |
void init_tok
|
|
|
302 |
PROTO_N ( ( c ) )
|
|
|
303 |
PROTO_T ( int c )
|
|
|
304 |
{
|
|
|
305 |
if ( output_std ) {
|
|
|
306 |
/* Backwards compatibility */
|
|
|
307 |
if ( c ) {
|
|
|
308 |
special_token [ TOK_bitf_sign ].builtin = 2 ;
|
|
|
309 |
special_token [ TOK_pv_compare ].builtin = 2 ;
|
|
|
310 |
special_token [ TOK_empty_align ].builtin = 2 ;
|
|
|
311 |
special_token [ TOK_empty_offset ].builtin = 2 ;
|
|
|
312 |
special_token [ TOK_empty_shape ].builtin = 2 ;
|
|
|
313 |
}
|
|
|
314 |
special_token [ TOK_ptr_rep ].builtin = 2 ;
|
|
|
315 |
}
|
|
|
316 |
if ( c ) {
|
|
|
317 |
special_token [ TOK_start ].builtin = 2 ;
|
|
|
318 |
base_token [ ntype_bool ].tok = TOK_signed_int ;
|
|
|
319 |
base_token [ ntype_bool ].no = ARITH_sint ;
|
|
|
320 |
}
|
|
|
321 |
return ;
|
|
|
322 |
}
|
|
|
323 |
|
|
|
324 |
|
|
|
325 |
/*
|
|
|
326 |
SET A SPECIAL TOKEN
|
|
|
327 |
|
|
|
328 |
This routine sets the special token t to be id.
|
|
|
329 |
*/
|
|
|
330 |
|
|
|
331 |
void set_special
|
|
|
332 |
PROTO_N ( ( t, id ) )
|
|
|
333 |
PROTO_T ( int t X IDENTIFIER id )
|
|
|
334 |
{
|
|
|
335 |
if ( !IS_NULL_id ( id ) ) {
|
|
|
336 |
ulong n = DEREF_ulong ( id_no ( id ) ) ;
|
|
|
337 |
ulong m = special_token [t].no ;
|
|
|
338 |
if ( n == LINK_NONE ) {
|
|
|
339 |
COPY_ulong ( id_no ( id ), m ) ;
|
|
|
340 |
special_token [t].tok = id ;
|
|
|
341 |
} else if ( m == LINK_NONE ) {
|
|
|
342 |
special_token [t].no = n ;
|
|
|
343 |
special_token [t].tok = id ;
|
|
|
344 |
} else {
|
|
|
345 |
/* Should not happen */
|
|
|
346 |
/* EMPTY */
|
|
|
347 |
}
|
|
|
348 |
}
|
|
|
349 |
return ;
|
|
|
350 |
}
|
|
|
351 |
|
|
|
352 |
|
|
|
353 |
/*
|
|
|
354 |
GET A SPECIAL TOKEN
|
|
|
355 |
|
|
|
356 |
This routine returns the token identifier associated with special
|
|
|
357 |
token t. If force is true then this involves looking up the name
|
|
|
358 |
in the token namespace. The null identifier is returned if there
|
|
|
359 |
is no associated identifier.
|
|
|
360 |
*/
|
|
|
361 |
|
|
|
362 |
IDENTIFIER get_special
|
|
|
363 |
PROTO_N ( ( t, force ) )
|
|
|
364 |
PROTO_T ( int t X int force )
|
|
|
365 |
{
|
|
|
366 |
IDENTIFIER id = special_token [t].tok ;
|
|
|
367 |
if ( IS_NULL_id ( id ) && force ) {
|
|
|
368 |
if ( special_token [t].builtin != 2 ) {
|
|
|
369 |
string s = ustrlit ( special_token [t].name ) ;
|
|
|
370 |
unsigned long h = hash ( s ) ;
|
|
|
371 |
HASHID nm = lookup_name ( s, h, 0, lex_identifier ) ;
|
|
|
372 |
NAMESPACE ns = token_namespace ;
|
|
|
373 |
MEMBER mem = search_member ( ns, nm, 0 ) ;
|
|
|
374 |
if ( !IS_NULL_member ( mem ) ) {
|
|
|
375 |
id = DEREF_id ( member_id ( mem ) ) ;
|
|
|
376 |
set_special ( t, id ) ;
|
|
|
377 |
}
|
|
|
378 |
}
|
|
|
379 |
}
|
|
|
380 |
return ( id ) ;
|
|
|
381 |
}
|
|
|
382 |
|
|
|
383 |
|
|
|
384 |
/*
|
|
|
385 |
GET A SPECIAL TOKEN NAME
|
|
|
386 |
|
|
|
387 |
This routine returns the name of the special token t.
|
|
|
388 |
*/
|
|
|
389 |
|
|
|
390 |
string special_name
|
|
|
391 |
PROTO_N ( ( t ) )
|
|
|
392 |
PROTO_T ( int t )
|
|
|
393 |
{
|
|
|
394 |
return ( ustrlit ( special_token [t].name ) ) ;
|
|
|
395 |
}
|
|
|
396 |
|
|
|
397 |
|
|
|
398 |
/*
|
|
|
399 |
FIND A TOKEN CODE LETTER
|
|
|
400 |
|
|
|
401 |
This routine returns the token code letter corresponding to the token
|
|
|
402 |
tok.
|
|
|
403 |
*/
|
|
|
404 |
|
|
|
405 |
int token_code
|
|
|
406 |
PROTO_N ( ( tok ) )
|
|
|
407 |
PROTO_T ( TOKEN tok )
|
|
|
408 |
{
|
|
|
409 |
if ( !IS_NULL_tok ( tok ) ) {
|
|
|
410 |
switch ( TAG_tok ( tok ) ) {
|
|
|
411 |
case tok_exp_tag :
|
|
|
412 |
case tok_stmt_tag :
|
|
|
413 |
case tok_func_tag :
|
|
|
414 |
case tok_member_tag : {
|
|
|
415 |
return ( 'E' ) ;
|
|
|
416 |
}
|
|
|
417 |
case tok_nat_tag : {
|
|
|
418 |
return ( 'N' ) ;
|
|
|
419 |
}
|
|
|
420 |
case tok_snat_tag : {
|
|
|
421 |
return ( 'Z' ) ;
|
|
|
422 |
}
|
|
|
423 |
case tok_type_tag : {
|
|
|
424 |
BASE_TYPE bt = DEREF_btype ( tok_type_kind ( tok ) ) ;
|
|
|
425 |
if ( bt & btype_scalar ) return ( 'Z' ) ;
|
|
|
426 |
return ( 'S' ) ;
|
|
|
427 |
}
|
|
|
428 |
case tok_proc_tag : {
|
|
|
429 |
TOKEN res = DEREF_tok ( tok_proc_res ( tok ) ) ;
|
|
|
430 |
return ( token_code ( res ) ) ;
|
|
|
431 |
}
|
|
|
432 |
}
|
|
|
433 |
}
|
|
|
434 |
return ( '?' ) ;
|
|
|
435 |
}
|
|
|
436 |
|
|
|
437 |
|
|
|
438 |
/*
|
|
|
439 |
CREATE A TOKEN SORT
|
|
|
440 |
|
|
|
441 |
This routine creates a token sort corresponding (more or less) to the
|
|
|
442 |
string s. If proc is true then the result is a procedure token.
|
|
|
443 |
*/
|
|
|
444 |
|
|
|
445 |
TOKEN make_sort
|
|
|
446 |
PROTO_N ( ( s, proc ) )
|
|
|
447 |
PROTO_T ( CONST char *s X int proc )
|
|
|
448 |
{
|
|
|
449 |
TOKEN tok ;
|
|
|
450 |
if ( proc ) {
|
|
|
451 |
unsigned i ;
|
|
|
452 |
TOKEN ptok ;
|
|
|
453 |
unsigned n = ( unsigned ) strlen ( s ) ;
|
|
|
454 |
LIST ( IDENTIFIER ) pids = NULL_list ( IDENTIFIER ) ;
|
|
|
455 |
tok = begin_proc_token () ;
|
|
|
456 |
for ( i = 1 ; i < n ; i++ ) {
|
|
|
457 |
IDENTIFIER pid ;
|
|
|
458 |
ptok = make_sort ( s + i, 0 ) ;
|
|
|
459 |
pid = make_tok_param ( ptok, 0, NULL_id ) ;
|
|
|
460 |
CONS_id ( pid, pids, pids ) ;
|
|
|
461 |
}
|
|
|
462 |
pids = REVERSE_list ( pids ) ;
|
|
|
463 |
tok = cont_proc_token ( tok, pids, pids ) ;
|
|
|
464 |
ptok = make_sort ( s, 0 ) ;
|
|
|
465 |
tok = end_proc_token ( tok, ptok ) ;
|
|
|
466 |
} else {
|
|
|
467 |
switch ( *s ) {
|
|
|
468 |
case 'E' : {
|
|
|
469 |
tok = make_exp_token ( type_error, 0, 0 ) ;
|
|
|
470 |
break ;
|
|
|
471 |
}
|
|
|
472 |
case 'N' : {
|
|
|
473 |
MAKE_tok_nat ( NULL_nat, tok ) ;
|
|
|
474 |
break ;
|
|
|
475 |
}
|
|
|
476 |
case 'S' : {
|
|
|
477 |
tok = make_type_token ( btype_none ) ;
|
|
|
478 |
break ;
|
|
|
479 |
}
|
|
|
480 |
case 'Z' : {
|
|
|
481 |
tok = make_type_token ( btype_int ) ;
|
|
|
482 |
break ;
|
|
|
483 |
}
|
|
|
484 |
default : {
|
|
|
485 |
FAIL ( Unknown sort ) ;
|
|
|
486 |
tok = NULL_tok ;
|
|
|
487 |
break ;
|
|
|
488 |
}
|
|
|
489 |
}
|
|
|
490 |
}
|
|
|
491 |
return ( tok ) ;
|
|
|
492 |
}
|
|
|
493 |
|
|
|
494 |
|
|
|
495 |
/*
|
|
|
496 |
CHECK A TOKEN SORT
|
|
|
497 |
|
|
|
498 |
This routine checks whether the sort of the token tok (either the
|
|
|
499 |
program sort or the bound sort, depending on the value of prog)
|
|
|
500 |
corresponds to the string s.
|
|
|
501 |
*/
|
|
|
502 |
|
|
|
503 |
static int check_sort
|
|
|
504 |
PROTO_N ( ( tok, s, prog ) )
|
|
|
505 |
PROTO_T ( TOKEN tok X CONST char *s X int prog )
|
|
|
506 |
{
|
|
|
507 |
char r = *( s++ ) ;
|
|
|
508 |
unsigned tag = TAG_tok ( tok ) ;
|
|
|
509 |
if ( tag == tok_func_tag ) {
|
|
|
510 |
/* Function tokens */
|
|
|
511 |
tok = func_proc_token ( tok ) ;
|
|
|
512 |
tag = TAG_tok ( tok ) ;
|
|
|
513 |
}
|
|
|
514 |
if ( tag == tok_proc_tag ) {
|
|
|
515 |
/* Procedure tokens */
|
|
|
516 |
LIST ( IDENTIFIER ) bids ;
|
|
|
517 |
TOKEN res = DEREF_tok ( tok_proc_res ( tok ) ) ;
|
|
|
518 |
char c = ( char ) token_code ( res ) ;
|
|
|
519 |
if ( c != r ) return ( 0 ) ;
|
|
|
520 |
r = *( s++ ) ;
|
|
|
521 |
if ( prog ) {
|
|
|
522 |
bids = DEREF_list ( tok_proc_pids ( tok ) ) ;
|
|
|
523 |
} else {
|
|
|
524 |
bids = DEREF_list ( tok_proc_bids ( tok ) ) ;
|
|
|
525 |
}
|
|
|
526 |
while ( !IS_NULL_list ( bids ) ) {
|
|
|
527 |
IDENTIFIER bid = DEREF_id ( HEAD_list ( bids ) ) ;
|
|
|
528 |
if ( !IS_NULL_id ( bid ) && IS_id_token ( bid ) ) {
|
|
|
529 |
res = DEREF_tok ( id_token_sort ( bid ) ) ;
|
|
|
530 |
c = ( char ) token_code ( res ) ;
|
|
|
531 |
} else {
|
|
|
532 |
c = '?' ;
|
|
|
533 |
}
|
|
|
534 |
if ( c != r ) return ( 0 ) ;
|
|
|
535 |
c = *s ;
|
|
|
536 |
if ( c == '*' ) {
|
|
|
537 |
/* Don't advance after '*' */
|
|
|
538 |
c = 0 ;
|
|
|
539 |
} else {
|
|
|
540 |
r = c ;
|
|
|
541 |
s++ ;
|
|
|
542 |
}
|
|
|
543 |
bids = TAIL_list ( bids ) ;
|
|
|
544 |
}
|
|
|
545 |
r = c ;
|
|
|
546 |
} else {
|
|
|
547 |
/* Other tokens */
|
|
|
548 |
char c = ( char ) token_code ( tok ) ;
|
|
|
549 |
if ( c != r ) return ( 0 ) ;
|
|
|
550 |
r = *s ;
|
|
|
551 |
}
|
|
|
552 |
if ( r ) return ( 0 ) ;
|
|
|
553 |
return ( 1 ) ;
|
|
|
554 |
}
|
|
|
555 |
|
|
|
556 |
|
|
|
557 |
/*
|
|
|
558 |
FIND A TOKEN WITH A GIVEN SORT
|
|
|
559 |
|
|
|
560 |
This routine checks whether id is a token with the given sort, giving
|
|
|
561 |
an error if id is not a token or has the wrong sort.
|
|
|
562 |
*/
|
|
|
563 |
|
|
|
564 |
IDENTIFIER resolve_token
|
|
|
565 |
PROTO_N ( ( id, s, prog ) )
|
|
|
566 |
PROTO_T ( IDENTIFIER id X CONST char *s X int prog )
|
|
|
567 |
{
|
|
|
568 |
int ok = 0 ;
|
|
|
569 |
IDENTIFIER rid = NULL_id ;
|
|
|
570 |
IDENTIFIER pid = id ;
|
|
|
571 |
while ( !IS_NULL_id ( pid ) ) {
|
|
|
572 |
IDENTIFIER tid = find_token ( pid ) ;
|
|
|
573 |
if ( IS_id_token ( tid ) ) {
|
|
|
574 |
TOKEN tok = DEREF_tok ( id_token_sort ( tid ) ) ;
|
|
|
575 |
if ( check_sort ( tok, s, prog ) ) {
|
|
|
576 |
if ( !IS_NULL_id ( rid ) ) {
|
|
|
577 |
report ( preproc_loc, ERR_lookup_ambig_id ( pid ) ) ;
|
|
|
578 |
break ;
|
|
|
579 |
}
|
|
|
580 |
rid = tid ;
|
|
|
581 |
} else {
|
|
|
582 |
report ( preproc_loc, ERR_pragma_token_sort ( pid ) ) ;
|
|
|
583 |
}
|
|
|
584 |
ok = 1 ;
|
|
|
585 |
}
|
|
|
586 |
if ( !IS_id_function_etc ( pid ) ) break ;
|
|
|
587 |
pid = DEREF_id ( id_function_etc_over ( pid ) ) ;
|
|
|
588 |
}
|
|
|
589 |
if ( !ok ) {
|
|
|
590 |
/* Token not found */
|
|
|
591 |
report ( preproc_loc, ERR_token_undecl ( id ) ) ;
|
|
|
592 |
}
|
|
|
593 |
return ( rid ) ;
|
|
|
594 |
}
|
|
|
595 |
|
|
|
596 |
|
|
|
597 |
/*
|
|
|
598 |
CHECK WHETHER A TOKEN IS A BUILT-IN TOKEN
|
|
|
599 |
|
|
|
600 |
This routine checks whether the token id is one of the built-in tokens
|
|
|
601 |
listed above. If so this definition is output, provided TDF output is
|
|
|
602 |
enabled, and the routine returns the corresponding special token number.
|
|
|
603 |
Otherwise the routine returns -1.
|
|
|
604 |
*/
|
|
|
605 |
|
|
|
606 |
int builtin_token
|
|
|
607 |
PROTO_N ( ( id ) )
|
|
|
608 |
PROTO_T ( IDENTIFIER id )
|
|
|
609 |
{
|
|
|
610 |
int t = 0 ;
|
|
|
611 |
string s ;
|
|
|
612 |
HASHID nm = DEREF_hashid ( id_name ( id ) ) ;
|
|
|
613 |
if ( !IS_hashid_name_etc ( nm ) ) return ( -1 ) ;
|
|
|
614 |
s = DEREF_string ( hashid_name_etc_text ( nm ) ) ;
|
|
|
615 |
if ( s [0] != '~' ) {
|
|
|
616 |
/* Only built-in types don't begin with '~' */
|
|
|
617 |
switch ( find_hashid ( nm ) ) {
|
|
|
618 |
case lex_ptrdiff_Ht : t = TOK_ptrdiff_t ; break ;
|
|
|
619 |
case lex_size_Ht : t = TOK_size_t ; break ;
|
|
|
620 |
case lex_size_Ht_H2 : t = TOK_size_t_2 ; break ;
|
|
|
621 |
case lex_wchar_Ht : t = TOK_wchar_t ; break ;
|
|
|
622 |
default : return ( -1 ) ;
|
|
|
623 |
}
|
|
|
624 |
}
|
|
|
625 |
while ( t < TOK_no ) {
|
|
|
626 |
int b = special_token [t].builtin ;
|
|
|
627 |
if ( b != 2 ) {
|
|
|
628 |
string n = ustrlit ( special_token [t].name ) ;
|
|
|
629 |
if ( ustreq ( s, n ) ) {
|
|
|
630 |
CONST char *p = special_token [t].sorts ;
|
|
|
631 |
TOKEN sort = DEREF_tok ( id_token_sort ( id ) ) ;
|
|
|
632 |
if ( !check_sort ( sort, p, 0 ) ) {
|
|
|
633 |
/* Check that token sort matches */
|
|
|
634 |
IDENTIFIER tid = DEREF_id ( id_token_alt ( id ) ) ;
|
|
|
635 |
report ( crt_loc, ERR_pragma_token_sort ( tid ) ) ;
|
|
|
636 |
return ( -1 ) ;
|
|
|
637 |
}
|
|
|
638 |
set_special ( t, id ) ;
|
|
|
639 |
if ( b ) {
|
|
|
640 |
/* Define token if possible */
|
|
|
641 |
DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
|
|
|
642 |
define_special ( t ) ;
|
|
|
643 |
ds |= ( dspec_defn | dspec_done ) ;
|
|
|
644 |
COPY_dspec ( id_storage ( id ), ds ) ;
|
|
|
645 |
}
|
|
|
646 |
return ( t ) ;
|
|
|
647 |
}
|
|
|
648 |
}
|
|
|
649 |
t++ ;
|
|
|
650 |
}
|
|
|
651 |
return ( -1 ) ;
|
|
|
652 |
}
|
|
|
653 |
|
|
|
654 |
|
|
|
655 |
/*
|
|
|
656 |
TDF ENCODING ROUTINES
|
|
|
657 |
|
|
|
658 |
The remaining routines in this module are only included if TDF output
|
|
|
659 |
is enabled.
|
|
|
660 |
*/
|
|
|
661 |
|
|
|
662 |
#if TDF_OUTPUT
|
|
|
663 |
|
|
|
664 |
|
|
|
665 |
/*
|
|
|
666 |
ENCODE A FOREIGN SORT
|
|
|
667 |
|
|
|
668 |
This routine adds the foreign sort named s to the bitstream bs.
|
|
|
669 |
*/
|
|
|
670 |
|
|
|
671 |
static BITSTREAM *enc_foreign_sort
|
|
|
672 |
PROTO_N ( ( bs, s ) )
|
|
|
673 |
PROTO_T ( BITSTREAM *bs X CONST char *s )
|
|
|
674 |
{
|
|
|
675 |
ENC_foreign_sort ( bs ) ;
|
|
|
676 |
ENC_make_string ( bs ) ;
|
|
|
677 |
bs = enc_ustring ( bs, ustrlit ( s ) ) ;
|
|
|
678 |
return ( bs ) ;
|
|
|
679 |
}
|
|
|
680 |
|
|
|
681 |
|
|
|
682 |
/*
|
|
|
683 |
ENCODE A SORT LETTER
|
|
|
684 |
|
|
|
685 |
This routine adds the TDF SORTNAME corresponding to the code letter s
|
|
|
686 |
to the bitstream bs.
|
|
|
687 |
*/
|
|
|
688 |
|
|
|
689 |
BITSTREAM *enc_sort
|
|
|
690 |
PROTO_N ( ( bs, s ) )
|
|
|
691 |
PROTO_T ( BITSTREAM *bs X int s )
|
|
|
692 |
{
|
|
|
693 |
switch ( s ) {
|
|
|
694 |
case 'A' : ENC_alignment_sort ( bs ) ; break ;
|
|
|
695 |
case 'B' : ENC_bool ( bs ) ; break ;
|
|
|
696 |
case 'C' : ENC_string ( bs ) ; break ;
|
|
|
697 |
case 'E' : ENC_exp ( bs ) ; break ;
|
|
|
698 |
case 'F' : ENC_floating_variety ( bs ) ; break ;
|
|
|
699 |
case 'L' : ENC_label ( bs ) ; break ;
|
|
|
700 |
case 'N' : ENC_nat ( bs ) ; break ;
|
|
|
701 |
case 'S' : ENC_shape ( bs ) ; break ;
|
|
|
702 |
case 'T' : ENC_ntest ( bs ) ; break ;
|
|
|
703 |
case 'U' : ENC_bitfield_variety ( bs ) ; break ;
|
|
|
704 |
case 'V' : ENC_variety ( bs ) ; break ;
|
|
|
705 |
case 'Z' : ENC_signed_nat ( bs ) ; break ;
|
|
|
706 |
case 'P' : {
|
|
|
707 |
bs = enc_foreign_sort ( bs, LINK_filename ) ;
|
|
|
708 |
break ;
|
|
|
709 |
}
|
|
|
710 |
#ifdef ENC_dg_filename_apply_token
|
|
|
711 |
case 'Q' : {
|
|
|
712 |
bs = enc_foreign_sort ( bs, LINK_dg_filename ) ;
|
|
|
713 |
break ;
|
|
|
714 |
}
|
|
|
715 |
#endif
|
|
|
716 |
default : {
|
|
|
717 |
FAIL ( Unknown sort ) ;
|
|
|
718 |
break ;
|
|
|
719 |
}
|
|
|
720 |
}
|
|
|
721 |
return ( bs ) ;
|
|
|
722 |
}
|
|
|
723 |
|
|
|
724 |
|
|
|
725 |
/*
|
|
|
726 |
ENCODE A TOKEN APPLICATION CONSTRUCT
|
|
|
727 |
|
|
|
728 |
This routine adds a token application construct for the sort with
|
|
|
729 |
code letter s to the bitstream bs.
|
|
|
730 |
*/
|
|
|
731 |
|
|
|
732 |
static BITSTREAM *enc_apply_token
|
|
|
733 |
PROTO_N ( ( bs, s ) )
|
|
|
734 |
PROTO_T ( BITSTREAM *bs X int s )
|
|
|
735 |
{
|
|
|
736 |
switch ( s ) {
|
|
|
737 |
case 'A' : ENC_alignment_apply_token ( bs ) ; break ;
|
|
|
738 |
case 'B' : ENC_bool_apply_token ( bs ) ; break ;
|
|
|
739 |
case 'C' : ENC_string_apply_token ( bs ) ; break ;
|
|
|
740 |
case 'E' : ENC_exp_apply_token ( bs ) ; break ;
|
|
|
741 |
case 'F' : ENC_flvar_apply_token ( bs ) ; break ;
|
|
|
742 |
case 'L' : ENC_label_apply_token ( bs ) ; break ;
|
|
|
743 |
case 'N' : ENC_nat_apply_token ( bs ) ; break ;
|
|
|
744 |
case 'S' : ENC_shape_apply_token ( bs ) ; break ;
|
|
|
745 |
case 'T' : ENC_ntest_apply_token ( bs ) ; break ;
|
|
|
746 |
case 'U' : ENC_bfvar_apply_token ( bs ) ; break ;
|
|
|
747 |
case 'V' : ENC_var_apply_token ( bs ) ; break ;
|
|
|
748 |
case 'Z' : ENC_signed_nat_apply_token ( bs ) ; break ;
|
|
|
749 |
case 'P' : ENC_filename_apply_token ( bs ) ; break ;
|
|
|
750 |
#ifdef ENC_dg_filename_apply_token
|
|
|
751 |
case 'Q' : ENC_dg_filename_apply_token ( bs ) ; break ;
|
|
|
752 |
#endif
|
|
|
753 |
default : FAIL ( Unknown sort ) ; break ;
|
|
|
754 |
}
|
|
|
755 |
return ( bs ) ;
|
|
|
756 |
}
|
|
|
757 |
|
|
|
758 |
|
|
|
759 |
/*
|
|
|
760 |
FIND A SPECIAL TOKEN NUMBER
|
|
|
761 |
|
|
|
762 |
This routine returns the external (capsule) token number of the
|
|
|
763 |
special token given by t.
|
|
|
764 |
*/
|
|
|
765 |
|
|
|
766 |
ulong special_no
|
|
|
767 |
PROTO_N ( ( t ) )
|
|
|
768 |
PROTO_T ( int t )
|
|
|
769 |
{
|
|
|
770 |
ulong n = special_token [t].no ;
|
|
|
771 |
if ( n == LINK_NONE ) {
|
|
|
772 |
/* Declare token */
|
|
|
773 |
int def = 0 ;
|
|
|
774 |
IDENTIFIER id = special_token [t].tok ;
|
|
|
775 |
if ( !IS_NULL_id ( id ) ) {
|
|
|
776 |
n = DEREF_ulong ( id_no ( id ) ) ;
|
|
|
777 |
if ( n != LINK_NONE ) {
|
|
|
778 |
special_token [t].no = n ;
|
|
|
779 |
return ( n ) ;
|
|
|
780 |
}
|
|
|
781 |
IGNORE capsule_id ( id, VAR_token ) ;
|
|
|
782 |
n = DEREF_ulong ( id_no ( id ) ) ;
|
|
|
783 |
} else {
|
|
|
784 |
string s = ustrlit ( special_token [t].name ) ;
|
|
|
785 |
if ( special_token [t].builtin == 2 ) {
|
|
|
786 |
s = NULL ;
|
|
|
787 |
def = 1 ;
|
|
|
788 |
}
|
|
|
789 |
n = capsule_no ( s, VAR_token ) ;
|
|
|
790 |
}
|
|
|
791 |
special_token [t].no = n ;
|
|
|
792 |
if ( tokdec_unit ) {
|
|
|
793 |
/* Declare token */
|
|
|
794 |
CONST char *sorts = special_token [t].sorts ;
|
|
|
795 |
enc_tokdec ( n, sorts ) ;
|
|
|
796 |
}
|
|
|
797 |
if ( def ) {
|
|
|
798 |
/* Define token if necessary */
|
|
|
799 |
define_special ( t ) ;
|
|
|
800 |
}
|
|
|
801 |
}
|
|
|
802 |
return ( n ) ;
|
|
|
803 |
}
|
|
|
804 |
|
|
|
805 |
|
|
|
806 |
/*
|
|
|
807 |
ENCODE A SPECIAL TOKEN
|
|
|
808 |
|
|
|
809 |
This routine adds an application of the special token given by t to
|
|
|
810 |
the bitstream bs. If the token takes no arguments the zero value
|
|
|
811 |
representing these arguments is added, otherwise the arguments must
|
|
|
812 |
be encoded by hand.
|
|
|
813 |
*/
|
|
|
814 |
|
|
|
815 |
BITSTREAM *enc_special
|
|
|
816 |
PROTO_N ( ( bs, t ) )
|
|
|
817 |
PROTO_T ( BITSTREAM *bs X int t )
|
|
|
818 |
{
|
|
|
819 |
ulong n ;
|
|
|
820 |
CONST char *sorts = special_token [t].sorts ;
|
|
|
821 |
bs = enc_apply_token ( bs, ( int ) sorts [0] ) ;
|
|
|
822 |
n = special_no ( t ) ;
|
|
|
823 |
n = link_no ( bs, n, VAR_token ) ;
|
|
|
824 |
ENC_make_tok ( bs, n ) ;
|
|
|
825 |
if ( sorts [1] ) {
|
|
|
826 |
/* Arguments must be encoded separately */
|
|
|
827 |
/* EMPTY */
|
|
|
828 |
} else {
|
|
|
829 |
ENC_LEN_SMALL ( bs, 0 ) ;
|
|
|
830 |
}
|
|
|
831 |
return ( bs ) ;
|
|
|
832 |
}
|
|
|
833 |
|
|
|
834 |
|
|
|
835 |
/*
|
|
|
836 |
ENCODE A SPECIAL DIAGNOSTICS TAG
|
|
|
837 |
|
|
|
838 |
Certain of the special tokens which represent types also have diagnostic
|
|
|
839 |
tag forms. This routine adds a diagnostic tag for the special token t
|
|
|
840 |
to the bitstream bs.
|
|
|
841 |
*/
|
|
|
842 |
|
|
|
843 |
BITSTREAM *enc_diag_special
|
|
|
844 |
PROTO_N ( ( bs, t, v ) )
|
|
|
845 |
PROTO_T ( BITSTREAM *bs X int t X int v )
|
|
|
846 |
{
|
|
|
847 |
ulong n = special_token [t].diag ;
|
|
|
848 |
if ( n == LINK_NONE ) {
|
|
|
849 |
string s = ustrlit ( special_token [t].name ) ;
|
|
|
850 |
n = capsule_no ( s, v ) ;
|
|
|
851 |
special_token [t].diag = n ;
|
|
|
852 |
}
|
|
|
853 |
n = link_no ( bs, n, v ) ;
|
|
|
854 |
#if TDF_NEW_DIAG
|
|
|
855 |
if ( v == VAR_dgtag ) {
|
|
|
856 |
ENC_dg_named_type ( bs ) ;
|
|
|
857 |
ENC_make_dg_tag ( bs, n ) ;
|
|
|
858 |
return ( bs ) ;
|
|
|
859 |
}
|
|
|
860 |
#endif
|
|
|
861 |
ENC_use_diag_tag ( bs ) ;
|
|
|
862 |
ENC_make_diag_tag ( bs, n ) ;
|
|
|
863 |
return ( bs ) ;
|
|
|
864 |
}
|
|
|
865 |
|
|
|
866 |
|
|
|
867 |
/*
|
|
|
868 |
ENCODE A TOKEN PARAMETER
|
|
|
869 |
|
|
|
870 |
This routine adds the nth parameter for a token with sort string sort
|
|
|
871 |
and parameters pars to the bitstream bs.
|
|
|
872 |
*/
|
|
|
873 |
|
|
|
874 |
static BITSTREAM *enc_param
|
|
|
875 |
PROTO_N ( ( bs, n, sorts, pars ) )
|
|
|
876 |
PROTO_T ( BITSTREAM *bs X int n X CONST char *sorts X ulong *pars )
|
|
|
877 |
{
|
|
|
878 |
bs = enc_apply_token ( bs, ( int ) sorts [ n + 1 ] ) ;
|
|
|
879 |
ENC_make_tok ( bs, pars [n] ) ;
|
|
|
880 |
ENC_LEN_SMALL ( bs, 0 ) ;
|
|
|
881 |
return ( bs ) ;
|
|
|
882 |
}
|
|
|
883 |
|
|
|
884 |
|
|
|
885 |
/*
|
|
|
886 |
ENCODE THE DEFINITION OF A BUILT-IN SPECIAL TOKEN
|
|
|
887 |
|
|
|
888 |
Certain of the special tokens have built-in definitions. This routine
|
|
|
889 |
outputs such a definition for the special token t.
|
|
|
890 |
*/
|
|
|
891 |
|
|
|
892 |
void define_special
|
|
|
893 |
PROTO_N ( ( t ) )
|
|
|
894 |
PROTO_T ( int t )
|
|
|
895 |
{
|
|
|
896 |
BITSTREAM *bs ;
|
|
|
897 |
ulong pars [10] ;
|
|
|
898 |
CONST char *sorts ;
|
|
|
899 |
TYPE s = NULL_type ;
|
|
|
900 |
ulong n = special_no ( t ) ;
|
|
|
901 |
unsigned acc = find_usage ( n, VAR_token ) ;
|
|
|
902 |
if ( acc & USAGE_DEFN ) return ;
|
|
|
903 |
sorts = special_token [t].sorts ;
|
|
|
904 |
bs = enc_tokdef_start ( n, sorts, pars, 0 ) ;
|
|
|
905 |
switch ( t ) {
|
|
|
906 |
|
|
|
907 |
case TOK_bitf_sign : {
|
|
|
908 |
/* Bitfield sign (C version) */
|
|
|
909 |
BITSTREAM *ts ;
|
|
|
910 |
TYPE c = type_sint ;
|
|
|
911 |
ENC_bool_cond ( bs ) ;
|
|
|
912 |
ENC_and ( bs ) ;
|
|
|
913 |
ENC_make_int ( bs ) ;
|
|
|
914 |
bs = enc_variety ( bs, c ) ;
|
|
|
915 |
bs = enc_param ( bs, 0, sorts, pars ) ;
|
|
|
916 |
bs = enc_make_int ( bs, c, ARITH_uchar ) ;
|
|
|
917 |
ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
|
|
|
918 |
ENC_false ( ts ) ;
|
|
|
919 |
bs = enc_bitstream ( bs, ts ) ;
|
|
|
920 |
ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
|
|
|
921 |
ENC_true ( ts ) ;
|
|
|
922 |
bs = enc_bitstream ( bs, ts ) ;
|
|
|
923 |
break ;
|
|
|
924 |
}
|
|
|
925 |
|
|
|
926 |
case TOK_pv_compare : {
|
|
|
927 |
/* Comparison of pointer to void (C version) */
|
|
|
928 |
ENC_pointer_test ( bs ) ;
|
|
|
929 |
ENC_OFF ( bs ) ;
|
|
|
930 |
bs = enc_param ( bs, 3, sorts, pars ) ;
|
|
|
931 |
bs = enc_param ( bs, 2, sorts, pars ) ;
|
|
|
932 |
bs = enc_param ( bs, 0, sorts, pars ) ;
|
|
|
933 |
bs = enc_param ( bs, 1, sorts, pars ) ;
|
|
|
934 |
break ;
|
|
|
935 |
}
|
|
|
936 |
|
|
|
937 |
case TOK_ptr_rep : {
|
|
|
938 |
/* Integral type the same size as a pointer */
|
|
|
939 |
bs = enc_make_snat ( bs, ARITH_ulong ) ;
|
|
|
940 |
break ;
|
|
|
941 |
}
|
|
|
942 |
|
|
|
943 |
case TOK_empty_align : {
|
|
|
944 |
/* Alignment of empty class (C version) */
|
|
|
945 |
bs = enc_alignment ( bs, type_ldouble ) ;
|
|
|
946 |
break ;
|
|
|
947 |
}
|
|
|
948 |
|
|
|
949 |
case TOK_empty_offset : {
|
|
|
950 |
/* Offset of empty class (C version) */
|
|
|
951 |
BITSTREAM *ts ;
|
|
|
952 |
TYPE c = type_char ;
|
|
|
953 |
bs = enc_special ( bs, TOK_comp_off ) ;
|
|
|
954 |
ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
|
|
|
955 |
ENC_offset_add ( ts ) ;
|
|
|
956 |
ENC_offset_zero ( ts ) ;
|
|
|
957 |
ts = enc_alignment ( ts, c ) ;
|
|
|
958 |
ENC_shape_offset ( ts ) ;
|
|
|
959 |
ts = enc_shape ( ts, c ) ;
|
|
|
960 |
bs = enc_bitstream ( bs, ts ) ;
|
|
|
961 |
break ;
|
|
|
962 |
}
|
|
|
963 |
|
|
|
964 |
case TOK_empty_shape : {
|
|
|
965 |
/* Shape of empty class (C version) */
|
|
|
966 |
ENC_compound ( bs ) ;
|
|
|
967 |
bs = enc_special ( bs, TOK_empty_offset ) ;
|
|
|
968 |
break ;
|
|
|
969 |
}
|
|
|
970 |
|
|
|
971 |
case TOK_start : {
|
|
|
972 |
/* Start of main routine (C version) */
|
|
|
973 |
ENC_make_top ( bs ) ;
|
|
|
974 |
break ;
|
|
|
975 |
}
|
|
|
976 |
|
|
|
977 |
case TOK_char_offset : {
|
|
|
978 |
/* Character offset */
|
|
|
979 |
TYPE c = type_char ;
|
|
|
980 |
ENC_offset_pad ( bs ) ;
|
|
|
981 |
ENC_alignment ( bs ) ;
|
|
|
982 |
bs = enc_shape ( bs, c ) ;
|
|
|
983 |
ENC_shape_offset ( bs ) ;
|
|
|
984 |
bs = enc_shape ( bs, c ) ;
|
|
|
985 |
break ;
|
|
|
986 |
}
|
|
|
987 |
|
|
|
988 |
case TOK_shape_offset : {
|
|
|
989 |
/* Shape offset */
|
|
|
990 |
ENC_offset_pad ( bs ) ;
|
|
|
991 |
ENC_alignment ( bs ) ;
|
|
|
992 |
bs = enc_param ( bs, 0, sorts, pars ) ;
|
|
|
993 |
ENC_shape_offset ( bs ) ;
|
|
|
994 |
bs = enc_param ( bs, 0, sorts, pars ) ;
|
|
|
995 |
break ;
|
|
|
996 |
}
|
|
|
997 |
|
|
|
998 |
case TOK_extra_offset : {
|
|
|
999 |
/* Offset padding */
|
|
|
1000 |
ENC_offset_subtract ( bs ) ;
|
|
|
1001 |
ENC_offset_pad ( bs ) ;
|
|
|
1002 |
bs = enc_param ( bs, 0, sorts, pars ) ;
|
|
|
1003 |
bs = enc_param ( bs, 1, sorts, pars ) ;
|
|
|
1004 |
ENC_offset_zero ( bs ) ;
|
|
|
1005 |
bs = enc_param ( bs, 0, sorts, pars ) ;
|
|
|
1006 |
break ;
|
|
|
1007 |
}
|
|
|
1008 |
|
|
|
1009 |
case TOK_down_cast : {
|
|
|
1010 |
/* Down cast from non-trivial base */
|
|
|
1011 |
BITSTREAM *ts, *us ;
|
|
|
1012 |
TYPE c = type_char ;
|
|
|
1013 |
bs = enc_special ( bs, TOK_ptr_to_ptr ) ;
|
|
|
1014 |
ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
|
|
|
1015 |
ts = enc_alignment ( ts, c ) ;
|
|
|
1016 |
ts = enc_param ( ts, 0, sorts, pars ) ;
|
|
|
1017 |
ENC_add_to_ptr ( ts ) ;
|
|
|
1018 |
ts = enc_special ( ts, TOK_ptr_to_ptr ) ;
|
|
|
1019 |
us = start_bitstream ( NIL ( FILE ), ts->link ) ;
|
|
|
1020 |
us = enc_param ( us, 0, sorts, pars ) ;
|
|
|
1021 |
us = enc_alignment ( us, c ) ;
|
|
|
1022 |
us = enc_param ( us, 1, sorts, pars ) ;
|
|
|
1023 |
ts = enc_bitstream ( ts, us ) ;
|
|
|
1024 |
ENC_offset_negate ( ts ) ;
|
|
|
1025 |
ts = enc_special ( ts, TOK_extra_offset ) ;
|
|
|
1026 |
us = start_bitstream ( NIL ( FILE ), ts->link ) ;
|
|
|
1027 |
us = enc_alignment ( us, c ) ;
|
|
|
1028 |
us = enc_param ( us, 2, sorts, pars ) ;
|
|
|
1029 |
ts = enc_bitstream ( ts, us ) ;
|
|
|
1030 |
bs = enc_bitstream ( bs, ts ) ;
|
|
|
1031 |
break ;
|
|
|
1032 |
}
|
|
|
1033 |
|
|
|
1034 |
case TOK_destr_cast : {
|
|
|
1035 |
BITSTREAM *ts ;
|
|
|
1036 |
bs = enc_special ( bs, TOK_ptr_to_ptr ) ;
|
|
|
1037 |
ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
|
|
|
1038 |
ts = enc_param ( ts, 0, sorts, pars ) ;
|
|
|
1039 |
ts = enc_special ( ts, TOK_empty_align ) ;
|
|
|
1040 |
ts = enc_param ( ts, 1, sorts, pars ) ;
|
|
|
1041 |
bs = enc_bitstream ( bs, ts ) ;
|
|
|
1042 |
break ;
|
|
|
1043 |
}
|
|
|
1044 |
|
|
|
1045 |
case TOK_destr_test : {
|
|
|
1046 |
BITSTREAM *ts ;
|
|
|
1047 |
ENC_pointer_test ( bs ) ;
|
|
|
1048 |
ENC_OFF ( bs ) ;
|
|
|
1049 |
bs = enc_ntest ( bs, ntest_not_eq ) ;
|
|
|
1050 |
bs = enc_param ( bs, 1, sorts, pars ) ;
|
|
|
1051 |
bs = enc_special ( bs, TOK_destr_ptr ) ;
|
|
|
1052 |
ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
|
|
|
1053 |
ts = enc_param ( ts, 0, sorts, pars ) ;
|
|
|
1054 |
bs = enc_bitstream ( bs, ts ) ;
|
|
|
1055 |
ENC_make_null_ptr ( bs ) ;
|
|
|
1056 |
bs = enc_special ( bs, TOK_empty_align ) ;
|
|
|
1057 |
break ;
|
|
|
1058 |
}
|
|
|
1059 |
|
|
|
1060 |
case TOK_except_jump : {
|
|
|
1061 |
/* Long jump */
|
|
|
1062 |
ENC_long_jump ( bs ) ;
|
|
|
1063 |
bs = enc_param ( bs, 0, sorts, pars ) ;
|
|
|
1064 |
bs = enc_param ( bs, 1, sorts, pars ) ;
|
|
|
1065 |
break ;
|
|
|
1066 |
}
|
|
|
1067 |
|
|
|
1068 |
case TOK_ptr_code : {
|
|
|
1069 |
/* Local label value pointer */
|
|
|
1070 |
ENC_pointer ( bs ) ;
|
|
|
1071 |
ENC_code_alignment ( bs ) ;
|
|
|
1072 |
s = type_void_star ;
|
|
|
1073 |
break ;
|
|
|
1074 |
}
|
|
|
1075 |
|
|
|
1076 |
case TOK_ptr_frame : {
|
|
|
1077 |
/* Procedure environment pointer */
|
|
|
1078 |
ENC_pointer ( bs ) ;
|
|
|
1079 |
#if ( TDF_major >= 4 )
|
|
|
1080 |
ENC_unite_alignments ( bs ) ;
|
|
|
1081 |
ENC_locals_alignment ( bs ) ;
|
|
|
1082 |
ENC_callers_alignment ( bs ) ;
|
|
|
1083 |
ENC_false ( bs ) ;
|
|
|
1084 |
#else
|
|
|
1085 |
ENC_frame_alignment ( bs ) ;
|
|
|
1086 |
#endif
|
|
|
1087 |
s = type_void_star ;
|
|
|
1088 |
break ;
|
|
|
1089 |
}
|
|
|
1090 |
|
|
|
1091 |
default : {
|
|
|
1092 |
FAIL ( Unknown special token ) ;
|
|
|
1093 |
break ;
|
|
|
1094 |
}
|
|
|
1095 |
}
|
|
|
1096 |
enc_tokdef_end ( n, bs ) ;
|
|
|
1097 |
if ( output_all && special_token [t].builtin == 2 ) {
|
|
|
1098 |
string e = ustrlit ( special_token [t].name ) ;
|
|
|
1099 |
IGNORE capsule_name ( n, &e, VAR_token ) ;
|
|
|
1100 |
}
|
|
|
1101 |
if ( output_diag ) {
|
|
|
1102 |
/* Output token diagnostics */
|
|
|
1103 |
IDENTIFIER id = special_token [t].tok ;
|
|
|
1104 |
if ( !IS_NULL_id ( id ) ) enc_diag_token ( id, s ) ;
|
|
|
1105 |
}
|
|
|
1106 |
return ;
|
|
|
1107 |
}
|
|
|
1108 |
|
|
|
1109 |
|
|
|
1110 |
/*
|
|
|
1111 |
ENCODE A TOKEN DEFINITION
|
|
|
1112 |
|
|
|
1113 |
This routine adds the definition of the token tok to the bitstream bs.
|
|
|
1114 |
*/
|
|
|
1115 |
|
|
|
1116 |
BITSTREAM *enc_tokdef_body
|
|
|
1117 |
PROTO_N ( ( bs, id, tok ) )
|
|
|
1118 |
PROTO_T ( BITSTREAM *bs X IDENTIFIER id X TOKEN tok )
|
|
|
1119 |
{
|
|
|
1120 |
if ( !IS_NULL_tok ( tok ) ) {
|
|
|
1121 |
int uc = unreached_code ;
|
|
|
1122 |
unreached_code = 0 ;
|
|
|
1123 |
switch ( TAG_tok ( tok ) ) {
|
|
|
1124 |
case tok_exp_tag : {
|
|
|
1125 |
EXP e = DEREF_exp ( tok_exp_value ( tok ) ) ;
|
|
|
1126 |
if ( IS_NULL_exp ( e ) ) goto undefined_token ;
|
|
|
1127 |
bs = enc_exp ( bs, e ) ;
|
|
|
1128 |
break ;
|
|
|
1129 |
}
|
|
|
1130 |
case tok_stmt_tag : {
|
|
|
1131 |
EXP e = DEREF_exp ( tok_stmt_value ( tok ) ) ;
|
|
|
1132 |
if ( IS_NULL_exp ( e ) ) goto undefined_token ;
|
|
|
1133 |
bs = enc_stmt ( bs, e ) ;
|
|
|
1134 |
break ;
|
|
|
1135 |
}
|
|
|
1136 |
case tok_nat_tag : {
|
|
|
1137 |
NAT n = DEREF_nat ( tok_nat_value ( tok ) ) ;
|
|
|
1138 |
if ( IS_NULL_nat ( n ) ) {
|
|
|
1139 |
ENC_computed_nat ( bs ) ;
|
|
|
1140 |
goto undefined_token ;
|
|
|
1141 |
}
|
|
|
1142 |
bs = enc_nat ( bs, n, 0 ) ;
|
|
|
1143 |
break ;
|
|
|
1144 |
}
|
|
|
1145 |
case tok_snat_tag : {
|
|
|
1146 |
NAT n = DEREF_nat ( tok_snat_value ( tok ) ) ;
|
|
|
1147 |
if ( IS_NULL_nat ( n ) ) {
|
|
|
1148 |
ENC_computed_signed_nat ( bs ) ;
|
|
|
1149 |
goto undefined_token ;
|
|
|
1150 |
}
|
|
|
1151 |
bs = enc_snat ( bs, n, 0, 0 ) ;
|
|
|
1152 |
break ;
|
|
|
1153 |
}
|
|
|
1154 |
case tok_type_tag : {
|
|
|
1155 |
TYPE t = DEREF_type ( tok_type_value ( tok ) ) ;
|
|
|
1156 |
BASE_TYPE bt = DEREF_btype ( tok_type_kind ( tok ) ) ;
|
|
|
1157 |
if ( bt & btype_scalar ) {
|
|
|
1158 |
if ( IS_NULL_type ( t ) ) {
|
|
|
1159 |
ENC_computed_signed_nat ( bs ) ;
|
|
|
1160 |
goto undefined_token ;
|
|
|
1161 |
}
|
|
|
1162 |
bs = enc_arith ( bs, t, 0 ) ;
|
|
|
1163 |
} else {
|
|
|
1164 |
if ( IS_NULL_type ( t ) ) {
|
|
|
1165 |
ENC_compound ( bs ) ;
|
|
|
1166 |
goto undefined_token ;
|
|
|
1167 |
}
|
|
|
1168 |
bs = enc_shape ( bs, t ) ;
|
|
|
1169 |
}
|
|
|
1170 |
break ;
|
|
|
1171 |
}
|
|
|
1172 |
case tok_member_tag : {
|
|
|
1173 |
OFFSET off = DEREF_off ( tok_member_value ( tok ) ) ;
|
|
|
1174 |
if ( IS_NULL_off ( off ) ) goto undefined_token ;
|
|
|
1175 |
bs = enc_offset ( bs, off ) ;
|
|
|
1176 |
break ;
|
|
|
1177 |
}
|
|
|
1178 |
case tok_proc_tag : {
|
|
|
1179 |
TOKEN res = DEREF_tok ( tok_proc_res ( tok ) ) ;
|
|
|
1180 |
bs = enc_tokdef_body ( bs, id, res ) ;
|
|
|
1181 |
break ;
|
|
|
1182 |
}
|
|
|
1183 |
undefined_token : {
|
|
|
1184 |
/* Output install-time error */
|
|
|
1185 |
EXP e ;
|
|
|
1186 |
ERROR err ;
|
|
|
1187 |
OPTION opt = option ( OPT_token_undef ) ;
|
|
|
1188 |
option ( OPT_token_undef ) = OPTION_ON ;
|
|
|
1189 |
err = ERR_token_undef ( id ) ;
|
|
|
1190 |
e = install_error ( NIL ( LOCATION ), err ) ;
|
|
|
1191 |
option ( OPT_token_undef ) = opt ;
|
|
|
1192 |
bs = enc_exp ( bs, e ) ;
|
|
|
1193 |
break ;
|
|
|
1194 |
}
|
|
|
1195 |
default : {
|
|
|
1196 |
FAIL ( Bad token sort ) ;
|
|
|
1197 |
break ;
|
|
|
1198 |
}
|
|
|
1199 |
}
|
|
|
1200 |
unreached_code = uc ;
|
|
|
1201 |
}
|
|
|
1202 |
return ( bs ) ;
|
|
|
1203 |
}
|
|
|
1204 |
|
|
|
1205 |
|
|
|
1206 |
/*
|
|
|
1207 |
ENCODE A TOKEN APPLICATION
|
|
|
1208 |
|
|
|
1209 |
This routine adds the application of the token id with arguments
|
|
|
1210 |
args to the bitstream bs.
|
|
|
1211 |
*/
|
|
|
1212 |
|
|
|
1213 |
BITSTREAM *enc_token
|
|
|
1214 |
PROTO_N ( ( bs, id, args ) )
|
|
|
1215 |
PROTO_T ( BITSTREAM *bs X IDENTIFIER id X LIST ( TOKEN ) args )
|
|
|
1216 |
{
|
|
|
1217 |
int s = enc_tokdef ( id, 0 ) ;
|
|
|
1218 |
ulong n = unit_no ( bs, id, VAR_token, 0 ) ;
|
|
|
1219 |
bs = enc_apply_token ( bs, s ) ;
|
|
|
1220 |
ENC_make_tok ( bs, n ) ;
|
|
|
1221 |
if ( IS_NULL_list ( args ) ) {
|
|
|
1222 |
ENC_LEN_SMALL ( bs, 0 ) ;
|
|
|
1223 |
} else {
|
|
|
1224 |
BITSTREAM *ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
|
|
|
1225 |
while ( !IS_NULL_list ( args ) ) {
|
|
|
1226 |
TOKEN tok = DEREF_tok ( HEAD_list ( args ) ) ;
|
|
|
1227 |
ts = enc_tokdef_body ( ts, id, tok ) ;
|
|
|
1228 |
args = TAIL_list ( args ) ;
|
|
|
1229 |
}
|
|
|
1230 |
bs = enc_bitstream ( bs, ts ) ;
|
|
|
1231 |
}
|
|
|
1232 |
return ( bs ) ;
|
|
|
1233 |
}
|
|
|
1234 |
|
|
|
1235 |
|
|
|
1236 |
/*
|
|
|
1237 |
ENCODE AN ASM EXPRESSION
|
|
|
1238 |
|
|
|
1239 |
This routine adds the assembler directive e to the bitstream bs.
|
|
|
1240 |
*/
|
|
|
1241 |
|
|
|
1242 |
BITSTREAM *enc_asm
|
|
|
1243 |
PROTO_N ( ( bs, e ) )
|
|
|
1244 |
PROTO_T ( BITSTREAM *bs X EXP e )
|
|
|
1245 |
{
|
|
|
1246 |
STRING op = DEREF_str ( exp_assembler_op ( e ) ) ;
|
|
|
1247 |
unsigned long len = DEREF_ulong ( str_simple_len ( op ) ) ;
|
|
|
1248 |
if ( len ) {
|
|
|
1249 |
BITSTREAM *ts, *us ;
|
|
|
1250 |
bs = enc_special ( bs, TOK_asm_sequence ) ;
|
|
|
1251 |
ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
|
|
|
1252 |
ts = enc_special ( ts, TOK_asm ) ;
|
|
|
1253 |
us = start_bitstream ( NIL ( FILE ), ts->link ) ;
|
|
|
1254 |
us = enc_strlit ( us, op ) ;
|
|
|
1255 |
ts = enc_bitstream ( ts, us ) ;
|
|
|
1256 |
bs = enc_bitstream ( bs, ts ) ;
|
|
|
1257 |
} else {
|
|
|
1258 |
ENC_make_top ( bs ) ;
|
|
|
1259 |
}
|
|
|
1260 |
return ( bs ) ;
|
|
|
1261 |
}
|
|
|
1262 |
|
|
|
1263 |
|
|
|
1264 |
#else /* TDF_OUTPUT */
|
|
|
1265 |
|
|
|
1266 |
|
|
|
1267 |
/*
|
|
|
1268 |
ENCODE THE DEFINITION OF A BUILT-IN SPECIAL TOKEN (DUMMY VERSION)
|
|
|
1269 |
|
|
|
1270 |
This routine is a dummy version of define_special used when TDF
|
|
|
1271 |
output is disabled.
|
|
|
1272 |
*/
|
|
|
1273 |
|
|
|
1274 |
void define_special
|
|
|
1275 |
PROTO_N ( ( t ) )
|
|
|
1276 |
PROTO_T ( int t )
|
|
|
1277 |
{
|
|
|
1278 |
UNUSED ( t ) ;
|
|
|
1279 |
return ;
|
|
|
1280 |
}
|
|
|
1281 |
|
|
|
1282 |
|
|
|
1283 |
#endif /* TDF_OUTPUT */
|