Subversion Repositories tendra.SVN

Rev

Rev 7 | Details | Compare with Previous | Last modification | View Log | RSS feed

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