Subversion Repositories tendra.SVN

Rev

Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 7u83 1 
%prefixes%
2 
 
3 
terminal = lex_ ;
4 
 
5 
 
6 
%maps%
7 
 
8 
program ->  read_program ;
9 
access ->  read_access ;
10 
alignment ->  read_alignment ;
11 
al_tag ->  read_al_tag ;
12 
bitfield_variety ->  read_bitfield_variety ;
13 
bool ->  read_bool ;
14 
error_code ->  read_error_code ;
15 
error_code_list ->  read_error_code_list ;
16 
error_treatment ->  read_error_treatment ;
17 
exp ->  read_exp ;
18 
exp_list ->  read_exp_list ;
19 
floating_variety ->  read_floating_variety ;
20 
label ->  read_label ;
21 
nat ->  read_nat ;
22 
nat_option ->  read_nat_option ;
23 
ntest ->  read_ntest ;
24 
rounding_mode ->  read_rounding_mode ;
25 
shape ->  read_shape ;
26 
signed_nat ->  read_signed_nat ;
27 
string ->  read_string ;
28 
tag ->  read_tag ;
29 
token ->  read_token ;
30 
transfer_mode ->  read_transfer_mode ;
31 
variety ->  read_variety ;
32 
 
33 
AL_TAGDEC -> PTR_Al_tagdec ;
34 
INT -> int ;
35 
LABDEC -> PTR_Labdec ;
36 
NAME -> Name ;
37 
SORT -> Sort ;
38 
STRING -> PTR_char ;
39 
PTR_TDF -> PTR_TDF ;
40 
TAGDEC -> PTR_Tagdec ;
41 
TDF -> TDF ;
42 
TOKDEC -> PTR_Tokdec ;
43 
TOKPAR -> PTR_Tokpar ;
44 
ULONG -> unsigned_long ;
45 
 
46 
 
47 
%header% @{
48 
/*
49 
    		 Crown Copyright (c) 1997
50 
 
51 
    This TenDRA(r) Computer Program is subject to Copyright
52 
    owned by the United Kingdom Secretary of State for Defence
53 
    acting through the Defence Evaluation and Research Agency
54 
    (DERA).  It is made available to Recipients with a
55 
    royalty-free licence for its use, reproduction, transfer
56 
    to other parties and amendment for any purpose not excluding
57 
    product development provided that any such use et cetera
58 
    shall be deemed to be acceptance of the following conditions:-
59 
 
60 
	(1) Its Recipients shall ensure that this Notice is
61 
	reproduced upon any copies or amended versions of it;
62 
 
63 
	(2) Any amended version of it shall be clearly marked to
64 
	show both the nature of and the organisation responsible
65 
	for the relevant amendment or amendments;
66 
 
67 
	(3) Its onward transfer from a recipient to another
68 
	party shall be deemed to be that party's acceptance of
69 
	these conditions;
70 
 
71 
	(4) DERA gives no warranty or assurance as to its
72 
	quality or suitability for any purpose and DERA accepts
73 
	no liability whatsoever in relation to any use to which
74 
	it may be put.
75 
*/
76 
 
77 
 
78 
#include "config.h"
79 
#include "util.h"
80 
#include "defs.h"
81 
#include "encodings.h"
82 
#include "enc_nos.h"
83 
#include "consfile.h"
84 
#include "lex.h"
85 
#include "analyse_sort.h"
86 
#include "find_id.h"
87 
#include "readstreams.h"
88 
#include "standardsh.h"
89 
#include "syntax.h"
90 
#include "units.h"
91 
 
92 
#if FS_TENDRA
93 
#pragma TenDRA begin
94 
#pragma TenDRA unreachable code allow
95 
#pragma TenDRA variable analysis off
96 
#endif
97 
 
98 
static int saved = 0 ;
99 
#define CURRENT_TERMINAL (unsigned)lex_v.t
100 
#define ADVANCE_LEXER lex_v = reader ()
101 
#define SAVE_LEXER(e) ((saved = lex_v.t), (lex_v.t = (e)))
102 
#define RESTORE_LEXER (lex_v.t = saved)
103 
 
104 
typedef Al_tagdec *PTR_Al_tagdec ;
105 
typedef Labdec *PTR_Labdec ;
106 
typedef char *PTR_char ;
107 
typedef Tagdec *PTR_Tagdec ;
108 
typedef TDF *PTR_TDF ;
109 
typedef Tokdec *PTR_Tokdec ;
110 
typedef Tokpar *PTR_Tokpar ;
111 
typedef unsigned long unsigned_long ;
112 
 
113 
 
114 
static Tokpar * g_tokpars;
115 
static Sort g_sname;
116 
static TDF g_tok_defn;
117 
static TokSort g_toksort;
118 
int search_for_toks = 1;
119 
static Tokdec * g_tokformals;
120 
static int g_lastfield;
121 
static TDF g_shape;
122 
static TDF g_lastshape;
123 
 
124 
static Name * g_shtokname;
125 
static int g_has_vis = 0;
126 
static Bool issigned;
127 
static Labdec * g_labdec;
128 
static unsigned long intvalue;
129 
static TDF optlab;
130 
static TDF g_lower;
131 
static TDF g_upper;
132 
static Bool g_has_upper;
133 
static TDF intro_acc;
134 
static TDF intro_init;
135 
 
136 
static int query_t;
137 
static int g_cr_v;
138 
static int g_ce_v;
139 
static int g_unt;
140 
static Tagdec * g_app_tags;
141 
 
142 
static void do_procprops
143 
    PROTO_N ( (i) )
144 
    PROTO_T ( int i )
145 
{
146 
    switch(i) {
147 
       case 0: return;
148 
       case 1: OPTION(o_var_callers); return;
149 
       case 2: OPTION(o_var_callees); return;
150 
       case 3: OPTION(o_add_procprops(o_var_callers, o_var_callees)); return;
151 
       case 4: OPTION(o_untidy); return;
152 
       case 5: OPTION(o_add_procprops(o_var_callers, o_untidy)); return;
153 
       case 6: OPTION(o_add_procprops(o_var_callees, o_untidy)); return;
154 
       case 7: OPTION(o_add_procprops(o_var_callers,
155 
		      o_add_procprops(o_var_callees, o_untidy))); return;
156 
       case 8: OPTION(o_check_stack); return;
157 
       case 9: OPTION(o_add_procprops(o_var_callers,o_check_stack)); return;
158 
       case 10: OPTION(o_add_procprops(o_var_callees,o_check_stack)); return;
159 
       case 11: OPTION(o_add_procprops(o_check_stack,
160 
		       o_add_procprops(o_var_callers, o_var_callees))); return;
161 
       case 12: OPTION(o_add_procprops(o_untidy,o_check_stack)); return;
162 
       case 13: OPTION(o_add_procprops(o_check_stack,
163 
		       o_add_procprops(o_var_callers, o_untidy))); return;
164 
       case 14: OPTION(o_add_procprops(o_check_stack,
165 
		       o_add_procprops(o_var_callees, o_untidy))); return;
166 
       case 15: OPTION(o_add_procprops(o_check_stack,
167 
		       o_add_procprops(o_var_callers,
168 
		       o_add_procprops(o_var_callees, o_untidy)))); return;
169 
    }
170 
}
171 
 
172 
static int defaultlab = -1;
173 
static TDF g_lablist;
174 
int do_pp = 0;
175 
 
176 
static void success
177 
    PROTO_Z ()
178 
{
179 
    IGNORE printf("Reached end\n");
180 
    print_res();
181 
}
182 
 
183 
static int HAS_MAGIC = 1;
184 
unsigned long MAJOR_NO = major_version;
185 
unsigned long MINOR_NO = minor_version;
186 
 
187 
 
188 
@}, @{
189 
/*
190 
    		 Crown Copyright (c) 1997
191 
 
192 
    This TenDRA(r) Computer Program is subject to Copyright
193 
    owned by the United Kingdom Secretary of State for Defence
194 
    acting through the Defence Evaluation and Research Agency
195 
    (DERA).  It is made available to Recipients with a
196 
    royalty-free licence for its use, reproduction, transfer
197 
    to other parties and amendment for any purpose not excluding
198 
    product development provided that any such use et cetera
199 
    shall be deemed to be acceptance of the following conditions:-
200 
 
201 
	(1) Its Recipients shall ensure that this Notice is
202 
	reproduced upon any copies or amended versions of it;
203 
 
204 
	(2) Any amended version of it shall be clearly marked to
205 
	show both the nature of and the organisation responsible
206 
	for the relevant amendment or amendments;
207 
 
208 
	(3) Its onward transfer from a recipient to another
209 
	party shall be deemed to be that party's acceptance of
210 
	these conditions;
211 
 
212 
	(4) DERA gives no warranty or assurance as to its
213 
	quality or suitability for any purpose and DERA accepts
214 
	no liability whatsoever in relation to any use to which
215 
	it may be put.
216 
*/
217 
 
218 
 
219 
#ifndef SYNTAX_INCLUDED
220 
#define SYNTAX_INCLUDED
221 
 
222 
extern int do_pp;
223 
extern int search_for_toks;
224 
extern unsigned long MAJOR_NO ;
225 
extern unsigned long MINOR_NO ;
226 
@} ;
227 
 
228 
 
229 
%terminals%
230 
 
231 
 
232 
%actions%
233 
 
234 
<acc_l1> : () -> () = @{
235 
    current_TDF->no=1;
236 
@} ;
237 
 
238 
<acc_l2_dec> : () -> ( hold, x, prev ) = @{
239 
    @prev = current_TDF;
240 
    @hold = *current_TDF;
241 
    INIT_TDF(&@x);
242 
    RESET_TDF(&@x);
243 
@} ;
244 
 
245 
<acc_l3> : ( hold, x, prev ) -> () = @{
246 
    INIT_TDF(@prev);
247 
    RESET_TDF(@prev);
248 
    o_add_accesses(append_TDF(&@hold,1), append_TDF(&@x, 1));
249 
    current_TDF->no = 1;
250 
@} ;
251 
 
252 
<access1> : ( condexp, thenpt, elsept, hold ) -> () = @{
253 
    RESET_TDF(@hold);
254 
    o_access_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
255 
		  append_TDF(&@elsept,1));
256 
@} ;
257 
 
258 
<access2> : ( i ) -> () = @{
259 
    if (strcmp(constructs[@i].name, "visible")==0) { g_has_vis = 1; }
260 
@} ;
261 
 
262 
<al_list1_dec> : () -> ( hold, place ) = @{
263 
    @place = current_TDF;
264 
    @hold = *current_TDF;
265 
    INIT_TDF(current_TDF);
266 
@} ;
267 
 
268 
<al_list2> : ( hold, place ) -> () = @{
269 
    TDF second;
270 
    second = *current_TDF;
271 
    INIT_TDF(@place);
272 
    RESET_TDF(@place);
273 
    o_unite_alignments(append_TDF(&@hold,1), append_TDF(&second,1));
274 
@} ;
275 
 
276 
<al_list_opt1> : () -> () = @{
277 
    o_alignment(o_top);
278 
@} ;
279 
 
280 
<al_tag1> : () -> () = @{
281 
    char * n =lex_v.val.name;
282 
    Al_tagdec * x = find_al_tag(n);
283 
    if (x==(Al_tagdec*)0) {
284 
	x= MALLOC(Al_tagdec);
285 
	x->isdeffed =0; x->iskept=0;
286 
	NEW_IDNAME(x->idname, n, al_tag_ent);
287 
	x->next = al_tagdecs;
288 
	al_tagdecs = x;
289 
    }
290 
    x->isused =1;
291 
    make_al_tag(&x->idname.name);
292 
@} ;
293 
 
294 
<al_tagdef2> : ( x, al, hold, already_used ) -> () = @{
295 
    RESET_TDF(@hold);
296 
    o_make_al_tagdef( if (@already_used) {
297 
			  out_tdfint32(UL(non_local(&@x->idname.name,al_tag_ent)));
298 
			  } else {
299 
			      out_tdfint32(LOCNAME(@x->idname));
300 
			  },
301 
			  append_TDF(&@al, 1)
302 
			);
303 
    INC_LIST;
304 
@} ;
305 
 
306 
<al_tgdf1_dec> : () -> ( x, al, hold, already_used ) = @{
307 
    char * n =lex_v.val.name;
308 
    @x = find_al_tag(n);
309 
    SELECT_UNIT(al_tagdef_unit);
310 
    if (@x==(Al_tagdec*)0) {
311 
	@x= MALLOC(Al_tagdec); @x->isdeffed =0; @x->iskept=0; @x->isused=0;
312 
	NEW_IDNAME(@x->idname, n, al_tag_ent);
313 
	@x->next = al_tagdecs; al_tagdecs = @x;
314 
	@already_used = 0;
315 
    }
316 
    else @already_used = 1;
317 
    if (@x->isdeffed) { fail("Al_tag %s defined twice", n); }
318 
    @x->isdeffed = 1;
319 
    SET_TDF(@hold, &@al);
320 
@} ;
321 
 
322 
<alignment1> : ( condexp, thenpt, elsept, hold ) -> () = @{
323 
    RESET_TDF(@hold);
324 
    o_alignment_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
325 
		     append_TDF(&@elsept,1));
326 
@} ;
327 
 
328 
<alignment3> : ( at, hold ) -> () = @{
329 
    RESET_TDF(@hold);
330 
    o_obtain_al_tag(append_TDF(&@at, 1));
331 
@} ;
332 
 
333 
<alment2_dec> : () -> ( at, hold ) = @{
334 
    SET_TDF(@hold, &@at);
335 
@} ;
336 
 
337 
<bool1> : ( condexp, thenpt, elsept, hold ) -> () = @{
338 
    RESET_TDF(@hold);
339 
    o_bool_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
340 
		append_TDF(&@elsept,1));
341 
@} ;
342 
 
343 
<bvar3_dec> : () -> ( sg, nt, hold ) = @{
344 
    /* @nt uninitialised */
345 
    SET_TDF(@hold, &@sg);
346 
@} ;
347 
 
348 
<bvariety1> : ( condexp, thenpt, elsept, hold ) -> () = @{
349 
    RESET_TDF(@hold);
350 
    o_bfvar_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
351 
		 append_TDF(&@elsept,1));
352 
@} ;
353 
 
354 
<bvariety2> : () -> () = @{
355 
    if (issigned) { o_true; }
356 
    else { o_false; }
357 
@} ;
358 
 
359 
<bvariety4> : ( sg, nt, hold ) -> () = @{
360 
    RESET_TDF(@hold);
361 
    SET_TDF(@hold, &@nt);
362 
@} ;
363 
 
364 
<bvariety5> : ( sg, nt, hold ) -> () = @{
365 
    RESET_TDF(@hold);
366 
    o_bfvar_bits(append_TDF(&@sg,1), append_TDF(&@nt, 1));
367 
@} ;
368 
 
369 
<call1_dec> : () -> ( fn, sh, ps, vp ) = @{
370 
    /* @sh, @ps, @vp uninitialised */
371 
    @fn = *current_TDF;
372 
    INIT_TDF(current_TDF);
373 
@} ;
374 
 
375 
<call2> : ( sh ) -> () = @{
376 
    @sh = *current_TDF;
377 
    INIT_TDF(current_TDF);
378 
@} ;
379 
 
380 
<call3> : ( ps ) -> () = @{
381 
    @ps = *current_TDF;
382 
    INIT_TDF(current_TDF);
383 
@} ;
384 
 
385 
<call4> : ( fn, sh, ps, vp ) -> () = @{
386 
    @vp = *current_TDF;
387 
    INIT_TDF(current_TDF);
388 
    o_apply_proc(append_TDF(&@sh,1), append_TDF(&@fn,1),
389 
	    { append_TDF(&@ps, 1); current_TDF->no = @ps.no; },
390 
	      if (@vp.no !=0) { OPTION(append_TDF(&@vp,1)); }
391 
	    );
392 
@} ;
393 
 
394 
<callee1_dec> : () -> ( el, hold ) = @{
395 
    SET_TDF(@hold, &@el);
396 
@} ;
397 
 
398 
<callee2> : ( el, hold ) -> () = @{
399 
    RESET_TDF(@hold);
400 
    o_make_callee_list( { append_TDF(&@el,1); current_TDF->no = @el.no;} );
401 
@} ;
402 
 
403 
<callee3_dec> : () -> ( pt, sz, hold ) = @{
404 
    /* @sz uninitialised */
405 
    SET_TDF(@hold, &@pt);
406 
@} ;
407 
 
408 
<callee4> : ( pt, sz, hold ) -> () = @{
409 
    RESET_TDF(@hold);
410 
    SET_TDF(@hold, &@sz);
411 
@} ;
412 
 
413 
<callee5> : ( pt, sz, hold ) -> () = @{
414 
    RESET_TDF(@hold);
415 
    o_make_dynamic_callees(append_TDF(&@pt,1), append_TDF(&@sz,1));
416 
@} ;
417 
 
418 
<callee6> : () -> () = @{
419 
    o_same_callees;
420 
@} ;
421 
 
422 
<cevaropt1> : () -> () = @{
423 
    g_ce_v = 0;
424 
@} ;
425 
 
426 
<cevaropt2> : () -> () = @{
427 
    g_ce_v = 1;
428 
@} ;
429 
 
430 
<chvar1_dec> : () -> ( v, ex, hold ) = @{
431 
    /* @ex uninitialised */
432 
    SET_TDF(@hold, &@v);
433 
@} ;
434 
 
435 
<chvar2> : ( v, ex, hold ) -> () = @{
436 
    RESET_TDF(@hold);
437 
    SET_TDF(@hold, &@ex);
438 
@} ;
439 
 
440 
<chvar3> : ( v, ex, hold ) -> () = @{
441 
    RESET_TDF(@hold);
442 
    o_change_variety(o_wrap, append_TDF(&@v,1), append_TDF(&@ex,1));
443 
@} ;
444 
 
445 
<crvaropt1> : () -> () = @{
446 
    g_cr_v = 0;
447 
@} ;
448 
 
449 
<crvaropt2> : () -> () = @{
450 
    g_cr_v = 1;
451 
@} ;
452 
 
453 
<cseexp1_dec> : () -> ( cntrl, ll, hold ) = @{
454 
    /* @ll uninitialised */
455 
    SET_TDF(@hold, &@cntrl);
456 
@} ;
457 
 
458 
<cseexp2> : ( cntrl, ll, hold ) -> () = @{
459 
    RESET_TDF(@hold);
460 
    SET_TDF(@hold, &@ll);
461 
@} ;
462 
 
463 
<cseexp3> : ( cntrl, ll, hold ) -> () = @{
464 
    RESET_TDF(@hold);
465 
    o_case(o_false, append_TDF(&@cntrl,1),
466 
	   { append_TDF(&@ll,1); current_TDF->no = @ll.no; });
467 
@} ;
468 
 
469 
<ctag_def3> : ( tfexp, sigopt, hold, x ) -> () = @{
470 
    RESET_TDF(@hold);
471 
    @x->iscommon = 1;
472 
    o_common_tagdef(out_tdfint32(UL(non_local(&@x->idname.name, tag_ent))), {},
473 
	if (@sigopt.no !=0) { OPTION(append_TDF(&@sigopt, 1)); },
474 
	append_TDF(&@tfexp, 1));
475 
    INC_LIST;
476 
    @x->isdeffed = 1;
477 
@} ;
478 
 
479 
<ctag_def6> : ( tfexp, sigopt, hold, x, is_deced ) -> () = @{
480 
    RESET_TDF(@hold);
481 
    @x->iscommon = 1;
482 
    o_common_tagdef(out_tdfint32(UL(local_name(&@x->idname.name, tag_ent))), {},
483 
	if (@sigopt.no !=0) { OPTION(append_TDF(&@sigopt, @is_deced)); },
484 
	append_TDF(&@tfexp, 1));
485 
    INC_LIST;
486 
    SELECT_UNIT(tagdec_unit);
487 
    if (!@is_deced) {
488 
	o_common_tagdec(out_tdfint32(UL(non_local(&@x->idname.name,tag_ent))),
489 
	    {},
490 
	    if (@sigopt.no !=0) { OPTION(append_TDF(&@sigopt, 1)); },
491 
	    o_shape_apply_token(make_tok(&@x->sh.shtok), {}));
492 
	INC_LIST;
493 
    }
494 
    @x->isdeffed=1; @x->hassh =1;
495 
    if (!@is_deced) { @x->next = tagdecs; tagdecs = @x; }
496 
@} ;
497 
 
498 
<dest_o1_dec> : () -> ( hold ) = @{
499 
    SET_TDF(@hold, &optlab);
500 
@} ;
501 
 
502 
<dest_opt2> : ( hold ) -> () = @{
503 
    RESET_TDF(@hold);
504 
@} ;
505 
 
506 
<empty_snl> : () -> () = @{
507 
    g_tokpars = (Tokpar*)0;
508 
@} ;
509 
 
510 
<eopt1> : () -> () = @{
511 
    o_make_signed_nat(out_tdfbool(0), out_tdfint32(UL(0)));
512 
@} ;
513 
 
514 
<errc1> : () -> () = @{
515 
    current_TDF->no = 1;
516 
@} ;
517 
 
518 
<errc2> : () -> () = @{
519 
    current_TDF->no ++;
520 
@} ;
521 
 
522 
<errt1> : ( condexp, thenpt, elsept, hold ) -> () = @{
523 
    RESET_TDF(@hold);
524 
    o_errt_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
525 
		append_TDF(&@elsept,1));
526 
@} ;
527 
 
528 
<errt2_dec> : () -> ( l, hold ) = @{
529 
    SET_TDF(@hold, &@l);
530 
@} ;
531 
 
532 
<errt3> : ( l, hold ) -> () = @{
533 
    RESET_TDF(@hold);
534 
    o_error_jump(append_TDF(&@l,1));
535 
@} ;
536 
 
537 
<errt5> : ( l, hold ) -> () = @{
538 
    RESET_TDF(@hold);
539 
    o_trap({append_TDF(&@l,1); current_TDF->no = @l.no; });
540 
@} ;
541 
 
542 
<exp1> : ( condexp, thenpt, elsept, hold ) -> () = @{
543 
    RESET_TDF(@hold);
544 
    o_exp_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
545 
	       append_TDF(&@elsept,1));
546 
@} ;
547 
 
548 
<exp1_dec> : () -> ( first, second, place, n ) = @{
549 
    @n = lex_v.val.name;
550 
    @first = *current_TDF;
551 
    SET_TDF(@place, &@second);
552 
@} ;
553 
 
554 
<exp2> : ( first, second, place, n ) -> () = @{
555 
    INIT_TDF(@place);
556 
    RESET_TDF(@place);
557 
    if(strcmp(@n, "*+.")==0) {
558 
	o_add_to_ptr(append_TDF(&@first,1), append_TDF(&@second,1));
559 
    } else if(strcmp(@n, "*-*")==0) {
560 
	o_subtract_ptrs(append_TDF(&@first,1), append_TDF(&@second,1));
561 
    } else if(strcmp(@n, ".*")==0) {
562 
	o_offset_mult(append_TDF(&@first,1), append_TDF(&@second,1));
563 
    } else if(strcmp(@n, ".+.")==0) {
564 
	o_offset_add(append_TDF(&@first,1), append_TDF(&@second,1));
565 
    } else if(strcmp(@n, ".-.")==0) {
566 
	o_offset_subtract(append_TDF(&@first,1), append_TDF(&@second,1));
567 
    } else if(strcmp(@n, "./")==0) {
568 
	o_offset_div_by_int(append_TDF(&@first,1), append_TDF(&@second,1));
569 
    } else if(strcmp(@n, "./.")==0) {
570 
	o_offset_div(
571 
	    o_var_limits(
572 
		o_make_signed_nat(out_tdfbool(1), out_tdfint32(UL(MINSI))),
573 
		o_make_signed_nat(out_tdfbool(0), out_tdfint32(UL(MAXSI)))),
574 
	    append_TDF(&@first,1), append_TDF(&@second,1));
575 
    } else if(strcmp(@n, ".max.")==0) {
576 
	o_offset_max(append_TDF(&@first,1), append_TDF(&@second,1));
577 
    } else { fail("%s not an addrop", @n); }
578 
@} ;
579 
 
580 
<exp3> : ( first, second, place, n ) -> () = @{
581 
    INIT_TDF(@place);
582 
    RESET_TDF(@place);
583 
    if(strcmp(@n, "And")==0) {
584 
	o_and(append_TDF(&@first,1), append_TDF(&@second,1));
585 
    } else if(strcmp(@n, "Or")==0) {
586 
	o_or(append_TDF(&@first,1), append_TDF(&@second,1));
587 
    } else if(strcmp(@n, "Xor")==0) {
588 
	o_xor(append_TDF(&@first,1), append_TDF(&@second,1));
589 
    } else { fail("%s not a logop", @n); }
590 
@} ;
591 
 
592 
<exp5> : ( first, second, place, n ) -> () = @{
593 
    INIT_TDF(@place);
594 
    RESET_TDF(@place);
595 
    if (strcmp(@n,"%")==0) {
596 
	o_rem2(o_continue, o_continue, append_TDF(&@first,1),
597 
	       append_TDF(&@second,1));
598 
    } else if (strcmp(@n,"%1")==0) {
599 
	o_rem1(o_continue, o_continue, append_TDF(&@first,1),
600 
	       append_TDF(&@second,1));
601 
    } else if (strcmp(@n,"*")==0) {
602 
	o_mult(o_wrap, append_TDF(&@first,1), append_TDF(&@second,1));
603 
    } else if (strcmp(@n,"+")==0) {
604 
	o_plus(o_wrap, append_TDF(&@first,1), append_TDF(&@second,1));
605 
    } else if (strcmp(@n,"-")==0) {
606 
	o_minus(o_wrap, append_TDF(&@first,1), append_TDF(&@second,1));
607 
    } else if (strcmp(@n,"/")==0) {
608 
	o_div2(o_continue, o_continue, append_TDF(&@first,1),
609 
	       append_TDF(&@second,1));
610 
    } else if (strcmp(@n,"/1")==0) {
611 
	o_div1(o_continue, o_continue, append_TDF(&@first,1),
612 
	       append_TDF(&@second,1));
613 
    } else if (strcmp(@n,"<<")==0) {
614 
	o_shift_left(o_wrap, append_TDF(&@first,1), append_TDF(&@second,1));
615 
    } else if (strcmp(@n,"F*")==0) {
616 
	o_floating_mult(o_continue,
617 
	    { LIST_ELEM(append_TDF(&@first,1));
618 
	    LIST_ELEM(append_TDF(&@second,1)) });
619 
    } else if (strcmp(@n,">>")==0) {
620 
	o_shift_right(append_TDF(&@first,1), append_TDF(&@second,1));
621 
    } else if (strcmp(@n,"F+")==0) {
622 
	o_floating_plus(o_continue,
623 
	    { LIST_ELEM(append_TDF(&@first,1));
624 
	    LIST_ELEM(append_TDF(&@second,1)) });
625 
    } else if (strcmp(@n,"F-")==0) {
626 
	o_floating_minus(o_continue, append_TDF(&@first,1),
627 
			 append_TDF(&@second,1));
628 
    } else if (strcmp(@n,"F/")==0) {
629 
	o_floating_div(o_continue, append_TDF(&@first,1),
630 
		       append_TDF(&@second,1));
631 
    } else { fail("%s not an arithop", @n); }
632 
@} ;
633 
 
634 
<exp6> : ( first, second, place, n ) -> () = @{
635 
    INIT_TDF(@place);
636 
    RESET_TDF(@place);
637 
    o_assign(append_TDF(&@first,1), append_TDF(&@second,1));
638 
@} ;
639 
 
640 
<exp_sls1> : () -> () = @{
641 
    current_TDF->no =1;
642 
    o_make_top;
643 
@} ;
644 
 
645 
<exp_sls2> : () -> () = @{
646 
    current_TDF->no =1;
647 
@} ;
648 
 
649 
<exp_sls3_dec> : () -> ( nextexp, place ) = @{
650 
    SET_TDF(@place, &@nextexp);
651 
@} ;
652 
 
653 
<exp_sls4> : ( nextexp, place ) -> () = @{
654 
    RESET_TDF(@place);
655 
    if (lex_v.t == lex_semi) {
656 
	current_TDF->no +=1;
657 
	append_TDF(&@nextexp,1);
658 
    } else {
659 
	TDF stats;
660 
	stats = *current_TDF;
661 
	INIT_TDF(current_TDF);
662 
	o_sequence(
663 
	    { append_TDF(&stats,1); current_TDF->no = stats.no; },
664 
	    append_TDF(&@nextexp,1));
665 
	/* cheats LIST in o_sequence */
666 
    }
667 
@} ;
668 
 
669 
<exp_sls5> : () -> () = @{
670 
    o_make_top;
671 
@} ;
672 
 
673 
<expcond1_dec> : () -> ( thpart, elsepart, condlab, hold, old_lab, old_labdecs ) = @{
674 
    /* @elsepart, @condlab uninitialised */
675 
    @old_lab = defaultlab;
676 
    @old_labdecs = labdecs;
677 
    defaultlab = -1;
678 
    SET_TDF(@hold, &@thpart);
679 
@} ;
680 
 
681 
<expcond2> : ( elsepart, hold ) -> () = @{
682 
    RESET_TDF(@hold);
683 
    SET_TDF(@hold, &@elsepart);
684 
@} ;
685 
 
686 
<expcond3> : ( condlab, old_lab, old_labdecs ) -> () = @{
687 
    @condlab = optlab;
688 
    defaultlab = @old_lab;
689 
    tidy_labels(@old_labdecs);
690 
@} ;
691 
 
692 
<expcond4> : ( thpart, elsepart, condlab, hold ) -> () = @{
693 
    INIT_TDF(@hold);
694 
    RESET_TDF(@hold);
695 
    o_conditional(append_TDF(&@condlab,1),
696 
		  append_TDF(&@thpart,1), append_TDF(&@elsepart,1));
697 
@} ;
698 
 
699 
<expcons1_dec> : () -> ( sz, elist, hold ) = @{
700 
    /* @elist uninitialised */
701 
    SET_TDF(@hold, &@sz);
702 
@} ;
703 
 
704 
<expcons2> : ( sz, elist, hold ) -> () = @{
705 
    RESET_TDF(@hold);
706 
    SET_TDF(@hold, &@elist);
707 
@} ;
708 
 
709 
<expcons3> : ( sz, elist, hold ) -> () = @{
710 
    RESET_TDF(@hold);
711 
    o_make_compound(append_TDF(&@sz,1),
712 
		    { append_TDF(&@elist,1); current_TDF->no = @elist.no; });
713 
@} ;
714 
 
715 
<expdec1_dec> : () -> ( ldecs ) = @{
716 
    @ldecs = localdecs;
717 
@} ;
718 
 
719 
<expdec2> : ( ldecs ) -> () = @{
720 
    localdecs = @ldecs;
721 
@} ;
722 
 
723 
<expfail1> : () -> () = @{
724 
    o_fail_installer(read_string());
725 
@} ;
726 
 
727 
<exphold1_dec> : () -> ( new, hold, empty, lineno, char_pos ) = @{
728 
    @empty = (current_TDF->first == current_TDF->last &&
729 
	      current_TDF->first->usage == 0 &&
730 
	      current_TDF->first->offst == 0);
731 
    @lineno = cLINE;
732 
    @char_pos = bind;
733 
    if (!@empty || line_no_tok != -1) { SET_TDF(@hold, &@new); }
734 
@} ;
735 
 
736 
<exphold2> : ( new, hold, empty, lineno, char_pos ) -> () = @{
737 
    if (!@empty || line_no_tok != -1) {
738 
	SET(@hold);
739 
	RESET_TDF(@hold);
740 
	if (line_no_tok != -1) {
741 
	    o_exp_apply_token(
742 
		o_make_tok(out_tdfint32(UL(cname_to_lname(line_no_tok,tok_ent)))),
743 
		{ append_TDF(&@new,1);
744 
		  o_make_sourcemark(FILENAME(),
745 
			o_make_nat(out_tdfint32(@lineno)),
746 
			o_make_nat(out_tdfint32(UL(@char_pos))));
747 
			o_make_sourcemark(FILENAME(),
748 
			    o_make_nat(out_tdfint32(cLINE)),
749 
			    o_make_nat(out_tdfint32(UL(bind))));
750 
		});
751 
	 } else append_TDF(&@new,1);
752 
    }
753 
@} ;
754 
 
755 
<expl1> : () -> () = @{
756 
    current_TDF->no=0;
757 
@} ;
758 
 
759 
<expl2> : () -> () = @{
760 
    current_TDF->no++;
761 
@} ;
762 
 
763 
<explab1_dec> : () -> ( starter, elist, old_lablist, hold, old_labdecs ) = @{
764 
    /* @elist uninitialised */
765 
    @old_labdecs = labdecs;
766 
    @old_lablist = g_lablist;
767 
    INIT_TDF(&g_lablist);
768 
    SET_TDF(@hold, &@starter);
769 
@} ;
770 
 
771 
<explab2> : ( elist, hold ) -> () = @{
772 
    RESET_TDF(@hold);
773 
    SET_TDF(@hold, &@elist);
774 
@} ;
775 
 
776 
<explab3> : ( starter, elist, old_lablist, hold, old_labdecs ) -> () = @{
777 
    RESET_TDF(@hold);
778 
    o_labelled( { append_TDF(&g_lablist,1);
779 
		  current_TDF->no = g_lablist.no;},
780 
		  append_TDF(&@starter, 1),
781 
		  { append_TDF(&@elist,1);
782 
		    current_TDF->no = g_lablist.no;});
783 
    tidy_labels(@old_labdecs);
784 
    g_lablist = @old_lablist;
785 
@} ;
786 
 
787 
<expneg1_dec> : () -> ( e, hold ) = @{
788 
    SET_TDF(@hold, &@e);
789 
@} ;
790 
 
791 
<expnegate2> : ( e, hold ) -> () = @{
792 
    RESET_TDF(@hold);
793 
    o_negate(o_wrap, append_TDF(&@e,1));
794 
@} ;
795 
 
796 
<expproc1_dec> : () -> ( pars, vpar, body, sh, hold, old_locals, old_labels ) = @{
797 
    /* @pars, @vpar, @body uninitialised */
798 
    @old_locals = localdecs;
799 
    @old_labels = labdecs;
800 
    localdecs = (Tagdec*)0;
801 
    labdecs = (Labdec *)0;
802 
    SET_TDF(@hold, &@sh);
803 
@} ;
804 
 
805 
<expproc2> : ( pars, hold ) -> () = @{
806 
    RESET_TDF(@hold);
807 
    SET_TDF(@hold, &@pars)
808 
@} ;
809 
 
810 
<expproc3> : ( vpar, hold ) -> () = @{
811 
    RESET_TDF(@hold);
812 
    SET_TDF(@hold, &@vpar);
813 
@} ;
814 
 
815 
<expproc4> : ( body, hold ) -> () = @{
816 
    RESET_TDF(@hold);
817 
    SET_TDF(@hold, &@body);
818 
@} ;
819 
 
820 
<expproc5> : ( pars, vpar, body, sh, hold, old_locals, old_labels ) -> () = @{
821 
    RESET_TDF(@hold);
822 
    o_make_proc(append_TDF(&@sh,1),
823 
		{ append_TDF(&@pars,1); current_TDF->no = @pars.no;},
824 
		if (@vpar.no !=0) {OPTION(append_TDF(&@vpar,1)); },
825 
		append_TDF(&@body,1);)
826 
    while (labdecs != (Labdec *)0 ) {
827 
	if (!labdecs->declared) {
828 
	    fail("Label %s not declared", labdecs->idname.id);
829 
	}
830 
	labdecs = labdecs->next;
831 
    }
832 
    localdecs = @old_locals;
833 
    labdecs = @old_labels;
834 
@} ;
835 
 
836 
<exprep1_dec> : () -> ( st, bdy, condlab, hold, old_labdecs, old_lab ) = @{
837 
    /* @bdy, @condlab, @old_lab uninitialised */
838 
    @old_labdecs = labdecs;
839 
    SET_TDF(@hold, &@st);
840 
@} ;
841 
 
842 
<exprep2> : ( old_lab ) -> () = @{
843 
    @old_lab = defaultlab;
844 
    defaultlab = -1;
845 
@} ;
846 
 
847 
<exprep3> : ( bdy, condlab, hold ) -> () = @{
848 
    @condlab = optlab;
849 
    RESET_TDF(@hold);
850 
    SET_TDF(@hold, &@bdy);
851 
@} ;
852 
 
853 
<exprep4> : ( st, bdy, condlab, hold, old_labdecs, old_lab ) -> () = @{
854 
    RESET_TDF(@hold);
855 
    o_repeat(append_TDF(&@condlab,1), append_TDF(&@st,1), append_TDF(&@bdy,1));
856 
    tidy_labels(@old_labdecs);
857 
    defaultlab = @old_lab;
858 
@} ;
859 
 
860 
<expstar1> : () -> () = @{
861 
    char * n = lex_v.val.name;
862 
    Tagdec * x = find_tag(n);
863 
    if (x == (Tagdec*)0) { fail("%s is not a tag", n); }
864 
    else
865 
    if (!x->isvar || x->hassh == 0) {
866 
	fail("Don't know shape of %s", n);
867 
    }
868 
    o_contents(
869 
	if (x->hassh == 1) {
870 
	    o_shape_apply_token(make_tok(&x->sh.shtok), {});
871 
	} else { append_TDF(&x->sh.tdfsh, 0); },
872 
	o_obtain_tag(make_tag(&x->idname.name)));
873 
@} ;
874 
 
875 
<expstar2_dec> : () -> ( sh, e, hold ) = @{
876 
    /* @e uninitialised */
877 
    SET_TDF(@hold, &@sh);
878 
@} ;
879 
 
880 
<expstar3> : ( e, hold ) -> () = @{
881 
    RESET_TDF(@hold);
882 
    SET_TDF(@hold, &@e);
883 
@} ;
884 
 
885 
<expstar4> : ( sh, e, hold ) -> () = @{
886 
    RESET_TDF(@hold);
887 
    o_contents(append_TDF(&@sh,1), append_TDF(&@e,1));
888 
@} ;
889 
 
890 
<expstr1_dec> : () -> ( st, vart, hold ) = @{
891 
    /* @vart uninitialised */
892 
    SET_TDF(@hold, &@st);
893 
@} ;
894 
 
895 
<expstr2> : ( vart, hold ) -> () = @{
896 
    RESET_TDF(@hold);
897 
    SET_TDF(@hold, &@vart);
898 
@} ;
899 
 
900 
<expstring2> : ( st, vart, hold ) -> () = @{
901 
    RESET_TDF(@hold);
902 
    o_make_nof_int(append_TDF(&@vart, 1), append_TDF(&@st, 1););
903 
@} ;
904 
 
905 
<exptag1> : () -> () = @{
906 
    TDF tg;
907 
    tg = *current_TDF;
908 
    INIT_TDF(current_TDF);
909 
    o_obtain_tag(append_TDF(&tg,1));
910 
@} ;
911 
 
912 
<exptst1_dec> : () -> ( first, nt, second, hold, qt ) = @{
913 
    /* @nt, @second uninitialised */
914 
    @qt = query_t;
915 
    SET_TDF(@hold,&@first);
916 
@} ;
917 
 
918 
<exptst2> : ( nt, hold ) -> () = @{
919 
    RESET_TDF(@hold);
920 
    SET_TDF(@hold,&@nt);
921 
@} ;
922 
 
923 
<exptst3> : ( second, hold ) -> () = @{
924 
    RESET_TDF(@hold);
925 
    SET_TDF(@hold, &@second)
926 
@} ;
927 
 
928 
<exptst4> : ( first, nt, second, hold, qt ) -> () = @{
929 
    RESET_TDF(@hold);
930 
    switch(@qt) {
931 
	case lex_query:
932 
	    o_integer_test({}, append_TDF(&@nt,1), append_TDF(&optlab,1),
933 
	   		append_TDF(&@first, 1), append_TDF(&@second,1));
934 
	    break;
935 
	case lex_float__query:
936 
	    o_floating_test({}, o_impossible, append_TDF(&@nt,1),
937 
	   		append_TDF(&optlab,1),
938 
	   		append_TDF(&@first, 1), append_TDF(&@second,1));
939 
	    break;
940 
	case lex_ptr__query:
941 
	    o_pointer_test( {}, append_TDF(&@nt,1),append_TDF(&optlab,1),
942 
	   		append_TDF(&@first, 1), append_TDF(&@second,1));
943 
	    break;
944 
	case lex_proc__query:
945 
	    o_proc_test( {}, append_TDF(&@nt,1),append_TDF(&optlab,1),
946 
	   		append_TDF(&@first, 1), append_TDF(&@second,1)
947 
	   		);
948 
	    break;
949 
	case lex_offset__query:
950 
	    o_offset_test({}, append_TDF(&@nt,1), append_TDF(&optlab,1),
951 
	   		append_TDF(&@first, 1), append_TDF(&@second,1)
952 
	   		);
953 
	    break;
954 
	default: fail("Don't understand test");
955 
    }
956 
@} ;
957 
 
958 
<fden1_dec> : () -> ( mant, e, v, rm, hold, neg, r ) = @{
959 
    /* @v, @rm uninitialised */
960 
    @neg = 0;
961 
    @r = UL(radix);
962 
    SET_TDF(@hold, &@mant);
963 
    out_tdfstring_bytes(fformat(lex_v.val.name,lnum), 8, UI(lnum));
964 
    RESET_TDF(@hold);
965 
    SET_TDF(@hold, &@e);
966 
@} ;
967 
 
968 
<fden2_dec> : () -> ( mant, e, v, rm, hold, neg, r ) = @{
969 
    /* @v, @rm uninitialised */
970 
    @neg = 1;
971 
    @r = UL(radix);
972 
    SET_TDF(@hold, &@mant);
973 
    out_tdfstring_bytes(fformat(lex_v.val.name,lnum), 8, UI(lnum));
974 
    RESET_TDF(@hold);
975 
    SET_TDF(@hold, &@e);
976 
@} ;
977 
 
978 
<fden3> : ( v, hold ) -> () = @{
979 
    RESET_TDF(@hold);
980 
    SET_TDF(@hold, &@v);
981 
@} ;
982 
 
983 
<fden4> : ( rm, hold ) -> () = @{
984 
    RESET_TDF(@hold);
985 
    SET_TDF(@hold, &@rm);
986 
@} ;
987 
 
988 
<fden5> : ( mant, e, v, rm, hold, neg, r ) -> () = @{
989 
    RESET_TDF(@hold);
990 
    o_make_floating(append_TDF(&@v,1),
991 
		    append_TDF(&@rm,1),
992 
		    if (@neg) { o_true; } else { o_false; },
993 
		    o_make_string(append_TDF(&@mant, 1)),
994 
		    o_make_nat(out_tdfint32(@r)),
995 
		    append_TDF(&@e, 1));
996 
@} ;
997 
 
998 
<field1_dec> : () -> ( hold, x, y ) = @{
999 
    char * dotn = append_string(".",lex_v.val.name);
1000 
    char * n = lex_v.val.name;
1001 
    @x = find_tok(dotn);
1002 
    @y = find_tok(n);
1003 
    if (@x!=(Tokdec*)0 || @y!=(Tokdec*)0)
1004 
	    fail("Field name %s must be unique", dotn);
1005 
    @x = MALLOC(Tokdec); NEW_IDNAME(@x->idname, dotn, tok_ent);
1006 
    @x->isdeffed = 1; @x->isused=0; @x->iskept = 0;
1007 
    @x->sort.ressort.sort = exp_sort;
1008 
    @x->sort.pars = (Tokpar *)0;
1009 
 
1010 
    @y = MALLOC(Tokdec); NEW_IDNAME(@y->idname, n, tok_ent);
1011 
    @y->isdeffed = 1; @y->isused=0; @y->iskept = 0;
1012 
    @y->sort.ressort.sort = exp_sort;
1013 
    @y->sort.pars = MALLOC(Tokpar);
1014 
    @y->sort.pars->par.sort = exp_sort;
1015 
    @y->sort.pars->next = (Tokpar*)0;
1016 
    @x->next = @y;
1017 
    SET_TDF(@hold, &g_shape);
1018 
@} ;
1019 
 
1020 
<field2> : ( hold, x, y ) -> () = @{
1021 
    int tn;
1022 
    RESET_TDF(@hold);
1023 
    o_make_tokdef(out_tdfint32(LOCNAME(@x->idname)), {},
1024 
	o_token_def(o_exp, {},
1025 
	    if (g_lastfield==-1) { /* first field */
1026 
		o_offset_zero(o_alignment(append_TDF(&g_shape, 0)));
1027 
	    } else {
1028 
		o_offset_pad(o_alignment(append_TDF(&g_shape,0)),
1029 
		    o_offset_add(o_exp_apply_token(
1030 
			o_make_tok(out_tdfint32(UL(g_lastfield))),{}),
1031 
		    o_shape_offset(append_TDF(&g_lastshape, 1))))
1032 
	    }));
1033 
    g_lastfield = (int)(LOCNAME(@x->idname));
1034 
    g_lastshape = g_shape;
1035 
    INC_LIST;
1036 
    o_make_tokdef(out_tdfint32(LOCNAME(@y->idname)), {},
1037 
	o_token_def(o_exp,
1038 
	    LIST_ELEM(o_make_tokformals(o_exp,
1039 
		out_tdfint32(UL(tn=next_unit_name(tok_ent))))),
1040 
	    o_component(append_TDF(&g_lastshape,0),
1041 
		o_exp_apply_token(o_make_tok(out_tdfint32(UL(tn))),{}),
1042 
		o_exp_apply_token(
1043 
		    o_make_tok(out_tdfint32(UL(g_lastfield))),{}))));
1044 
    INC_LIST;
1045 
    @y->next = tokdecs;
1046 
    tokdecs = @x;
1047 
@} ;
1048 
 
1049 
<fvar1> : ( condexp, thenpt, elsept, hold ) -> () = @{
1050 
    RESET_TDF(@hold);
1051 
    o_flvar_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
1052 
		 append_TDF(&@elsept,1));
1053 
@} ;
1054 
 
1055 
<fvardouble> : () -> () = @{
1056 
    o_flvar_parms(o_make_nat(out_tdfint32(UL(2))),
1057 
		  o_make_nat(out_tdfint32(UL(MANT_DOUBLE))),
1058 
		  o_make_nat(out_tdfint32(UL(MINEXP_DOUBLE))),
1059 
		  o_make_nat(out_tdfint32(UL(MAXEXP_DOUBLE))));
1060 
@} ;
1061 
 
1062 
<fvarfloat> : () -> () = @{
1063 
    o_flvar_parms(o_make_nat(out_tdfint32(UL(2))),
1064 
		  o_make_nat(out_tdfint32(UL(MANT_FLOAT))),
1065 
		  o_make_nat(out_tdfint32(UL(MINEXP_FLOAT))),
1066 
		  o_make_nat(out_tdfint32(UL(MAXEXP_FLOAT))));
1067 
@} ;
1068 
 
1069 
<gcall1_dec> : () -> ( cers, cees, plude, cr_v, ce_v, old_app_tags, app_tags, old_tagdecs ) = @{
1070 
    /* @cers, @cees, @plude uninitialised */
1071 
    /* @cr_v, @ce_v, @app_tags uninitialised */
1072 
    @old_app_tags = g_app_tags;
1073 
    @old_tagdecs = tagdecs;
1074 
    g_app_tags = (Tagdec*)0;
1075 
@} ;
1076 
 
1077 
<gcall2> : ( cers, cr_v, old_app_tags, app_tags ) -> () = @{
1078 
    @cers = *current_TDF;
1079 
    INIT_TDF(current_TDF);
1080 
    @cr_v = g_cr_v;
1081 
    @app_tags = g_app_tags;
1082 
    g_app_tags = @old_app_tags;
1083 
@} ;
1084 
 
1085 
<gcall3> : ( cees, ce_v, app_tags ) -> () = @{
1086 
    @cees = *current_TDF;
1087 
    @ce_v = g_ce_v;
1088 
    INIT_TDF(current_TDF);
1089 
    while (@app_tags != (Tagdec*)0) {
1090 
	Tagdec * x = @app_tags;
1091 
	@app_tags = x->next;
1092 
	x->next = tagdecs;
1093 
	tagdecs = x;
1094 
    }
1095 
@} ;
1096 
 
1097 
<gcall4> : ( fn, sh, cers, cees, plude, cr_v, ce_v, old_tagdecs ) -> () = @{
1098 
    @plude = *current_TDF;
1099 
    INIT_TDF(current_TDF);
1100 
    tagdecs = @old_tagdecs;
1101 
    o_apply_general_proc(
1102 
	append_TDF(&@sh,1), do_procprops(@cr_v+2*@ce_v+4*g_unt),
1103 
	append_TDF(&@fn,1),
1104 
	{ append_TDF(&@cers,1); current_TDF->no = @cers.no; },
1105 
	append_TDF(&@cees,1),
1106 
	append_TDF(&@plude, 1))
1107 
@} ;
1108 
 
1109 
<gencond1_dec> : () -> ( condexp, thenpt, elsept, hold ) = @{
1110 
    /* @thenpt, @elsept uninitialised */
1111 
    SET_TDF(@hold, &@condexp);
1112 
@} ;
1113 
 
1114 
<gencond2> : ( thenpt, hold ) -> () = @{
1115 
    RESET_TDF(@hold);
1116 
    SET_TDF(@hold, &@thenpt);
1117 
@} ;
1118 
 
1119 
<gencond3> : ( elsept, hold ) -> () = @{
1120 
    RESET_TDF(@hold);
1121 
    SET_TDF(@hold, &@elsept);
1122 
@} ;
1123 
 
1124 
<gencons1_dec> : () -> ( i ) = @{
1125 
    @i = lex_v.val.v;
1126 
@} ;
1127 
 
1128 
<gencons2> : ( i ) -> () = @{
1129 
    (constructs[@i].f)();
1130 
@} ;
1131 
 
1132 
<genhold1_dec> : () -> ( new, hold, empty ) = @{
1133 
    @empty = (current_TDF->first == current_TDF->last &&
1134 
	      current_TDF->first->usage == 0 &&
1135 
	      current_TDF->first->offst == 0);
1136 
    if (!@empty) { SET_TDF(@hold, &@new); }
1137 
@} ;
1138 
 
1139 
<genhold2> : ( new, hold, empty ) -> () = @{
1140 
    if (!@empty ) {
1141 
	SET(@hold);
1142 
	RESET_TDF(@hold);
1143 
	append_TDF(&@new,1);
1144 
    }
1145 
@} ;
1146 
 
1147 
<gentok1_dec> : () -> ( td ) = @{
1148 
    @td = lex_v.val.tokname;
1149 
    @td->isused = 1;
1150 
@} ;
1151 
 
1152 
<gentok2> : ( td ) -> () = @{
1153 
    expand_tok(@td, &@td->sort);
1154 
@} ;
1155 
 
1156 
<gproc1_dec> : () -> ( sh, cers, cees, body, hold, cr_v, ce_v, c_unt, old_locals, old_labels ) = @{
1157 
    /* @cers, @cees, @body uninitialised */
1158 
    /* @cr_v, @ce_v @c_unt uninitialised */
1159 
    @old_locals = localdecs;
1160 
    @old_labels = labdecs;
1161 
    localdecs = (Tagdec*)0;
1162 
    labdecs = (Labdec *)0;
1163 
    SET_TDF(@hold, &@sh);
1164 
@} ;
1165 
 
1166 
<gproc2> : ( cers, hold ) -> () = @{
1167 
    RESET_TDF(@hold);
1168 
    SET_TDF(@hold, &@cers);
1169 
@} ;
1170 
 
1171 
<gproc3> : ( cees, hold, cr_v) -> () = @{
1172 
    RESET_TDF(@hold);
1173 
    SET_TDF(@hold, &@cees);
1174 
    @cr_v = g_cr_v;
1175 
@} ;
1176 
 
1177 
<gproc4> : ( body, hold, ce_v ) -> () = @{
1178 
    RESET_TDF(@hold);
1179 
    SET_TDF(@hold, &@body);
1180 
    @ce_v = g_ce_v;
1181 
@} ;
1182 
 
1183 
<gproc5> : ( c_unt ) -> () = @{
1184 
    @c_unt = g_unt;
1185 
@} ;
1186 
 
1187 
<gproc6> : ( sh, cers, cees, body, hold, cr_v, ce_v, c_unt, old_locals, old_labels ) -> () = @{
1188 
    RESET_TDF(@hold);
1189 
    o_make_general_proc(append_TDF(&@sh,1),
1190 
			do_procprops(@cr_v+2*@ce_v+4*@c_unt),
1191 
			{ append_TDF(&@cers,1);
1192 
			  current_TDF->no = @cers.no;},
1193 
			{ append_TDF(&@cees,1);
1194 
			  current_TDF->no = @cees.no;},
1195 
			append_TDF(&@body,1))
1196 
    while (labdecs != (Labdec *)0 ) {
1197 
	if (!labdecs->declared) {
1198 
	    fail("Label %s not declared", labdecs->idname.id);
1199 
	}
1200 
	labdecs = labdecs->next;
1201 
    }
1202 
    localdecs = @old_locals;
1203 
    labdecs = @old_labels;
1204 
@} ;
1205 
 
1206 
<ibody1_dec> : () -> ( acc, init, body, hold, tg, isvar ) = @{
1207 
    @isvar = localdecs->isvar;
1208 
    @acc = intro_acc;
1209 
    @init = intro_init;
1210 
    @tg = localdecs->idname.name;
1211 
    SET_TDF(@hold, &@body);
1212 
@} ;
1213 
 
1214 
<integer1> : () -> () = @{
1215 
    intvalue = UL(stoi(lex_v.val.name, lnum));
1216 
@} ;
1217 
 
1218 
<integer2> : () -> () = @{
1219 
    intvalue = UL(lex_v.val.v);
1220 
@} ;
1221 
 
1222 
<intro1_dec> : () -> ( acc, init, hold, x, has_vis ) = @{
1223 
    /* @init, @has_vis uninitialised */
1224 
    char* n = lex_v.val.name;
1225 
    @x = find_tag(n);
1226 
    if (@x != (Tagdec*)0) { fail("Tag %s declared twice", n); }
1227 
    @x = MALLOC(Tagdec); @x->isdeffed = 1; @x->hassh=0; @x->iskept=0;
1228 
    NEW_IDNAME(@x->idname, n, tag_ent);
1229 
    g_has_vis = 0;
1230 
    SET_TDF(@hold, &@acc);
1231 
@} ;
1232 
 
1233 
<intro2> : ( init, hold, has_vis ) -> () = @{
1234 
    RESET_TDF(@hold);
1235 
    SET_TDF(@hold, &@init);
1236 
    @has_vis = g_has_vis;
1237 
@} ;
1238 
 
1239 
<intro3> : ( hold, x ) -> () = @{
1240 
    RESET_TDF(@hold);
1241 
    SET_TDF(@hold, &@x->sh.tdfsh);
1242 
    @x->hassh=2;
1243 
@} ;
1244 
 
1245 
<intro4> : ( acc, init, hold, x, has_vis ) -> () = @{
1246 
    RESET_TDF(@hold);
1247 
    intro_acc = @acc;
1248 
    intro_init = @init;
1249 
    @x->isvar=1;
1250 
    if (@has_vis) {
1251 
	Tagdec * y = MALLOC(Tagdec);
1252 
	*y = *@x;
1253 
	y->next = tagdecs;
1254 
	tagdecs = y;
1255 
    }
1256 
    @x->next = localdecs;
1257 
    localdecs = @x;
1258 
@} ;
1259 
 
1260 
<intro5> : ( acc, init, hold, x, has_vis ) -> () = @{
1261 
    RESET_TDF(@hold);
1262 
    intro_acc = @acc;
1263 
    intro_init = @init;
1264 
    @x->isvar=0;
1265 
    if (@has_vis) {
1266 
	Tagdec * y = MALLOC(Tagdec);
1267 
	*y = *@x;
1268 
	y->next = tagdecs;
1269 
	tagdecs = y;
1270 
    }
1271 
    @x->next = localdecs;
1272 
    localdecs = @x;
1273 
@} ;
1274 
 
1275 
<intro6> : ( x ) -> () = @{
1276 
    o_make_value(append_TDF(&@x->sh.tdfsh, 0));
1277 
@} ;
1278 
 
1279 
<introbody2> : ( acc, init, body, hold, tg, isvar ) -> () = @{
1280 
    RESET_TDF(@hold);
1281 
    if (@isvar) {
1282 
	o_variable( if(@acc.no!=0) { OPTION(append_TDF(&@acc,1)); },
1283 
		    make_tag(&@tg), append_TDF(&@init,1),
1284 
		    append_TDF(&@body,1));
1285 
    } else {
1286 
	o_identify( if(@acc.no!=0) { OPTION(append_TDF(&@acc,1)); },
1287 
		    make_tag(&@tg), append_TDF(&@init,1),
1288 
		    append_TDF(&@body,1));
1289 
    }
1290 
@} ;
1291 
 
1292 
<keep1> : () -> () = @{
1293 
    Tokdec * k = lex_v.val.tokname;
1294 
    k->iskept = 1;
1295 
@} ;
1296 
 
1297 
<keep2> : () -> () = @{
1298 
    char * n = lex_v.val.name;
1299 
    Tagdec * t = find_tag(n);
1300 
    if (t != (Tagdec*)0){
1301 
	t->iskept = 1;
1302 
     } else {
1303 
	Al_tagdec * a = find_al_tag(n);
1304 
	if (a == (Al_tagdec*)0) {
1305 
	    fail("Ident %s not declared",n);
1306 
	}
1307 
	a->iskept = 1;
1308 
    }
1309 
@} ;
1310 
 
1311 
<keeps1> : () -> () = @{
1312 
    int i;
1313 
    for(i=0; i<NO_OF_ENTITIES; i++) {
1314 
	INIT_TDF(lk_externs+i);
1315 
    }
1316 
@} ;
1317 
 
1318 
<keeps2> : () -> () = @{
1319 
    CONT_STREAM(&units[tld2_unit].tdf, out_tdfint32(UL(1)));
1320 
    if(line_no_tok != -1) {
1321 
	current_TDF = lk_externs+tok_ent;
1322 
	o_make_linkextern(
1323 
	    out_tdfint32(UL(line_no_tok)),
1324 
		o_string_extern(
1325 
		    { out_tdfident_bytes("~exp_to_source"); }));
1326 
	current_TDF->no++;
1327 
	CONT_STREAM(&units[tld2_unit].tdf, out_tdfint32(UL(3)));
1328 
    }
1329 
    {
1330 
	Tokdec * k = tokdecs;
1331 
	while (k != (Tokdec*)0) {
1332 
	    if (!k->isdeffed || k->iskept) {
1333 
		int capname = capsule_name(&k->idname.name, tok_ent);
1334 
		char * n = k->idname.id;
1335 
		current_TDF = lk_externs+tok_ent;
1336 
		o_make_linkextern(out_tdfint32(UL(capname)),
1337 
		    o_string_extern({ out_tdfident_bytes(n); }));
1338 
		current_TDF->no++;
1339 
		CONT_STREAM(&units[tld2_unit].tdf,
1340 
		    { int i = k->isused + 2 + 4*k->isdeffed;
1341 
		      out_tdfint32(UL(i)); });
1342 
	    }
1343 
	    k = k->next;
1344 
	}
1345 
    }
1346 
    {
1347 
	Tagdec * k = tagdecs;
1348 
	while (k != (Tagdec*)0) {
1349 
	    if (!k->isdeffed || k->iskept) {
1350 
		int capname = capsule_name(&k->idname.name, tag_ent);
1351 
		char * n = k->idname.id;
1352 
		current_TDF = lk_externs+tag_ent;
1353 
		o_make_linkextern(out_tdfint32(UL(capname)),
1354 
		    o_string_extern({ out_tdfident_bytes(n); }));
1355 
		current_TDF->no++;
1356 
		CONT_STREAM(&units[tld2_unit].tdf,
1357 
		    { int i = k->isused + 2 + ((k->iscommon)?8:(4*k->isdeffed));
1358 
		      out_tdfint32(UL(i)); });
1359 
	    }
1360 
	    k = k->next;
1361 
	}
1362 
    }
1363 
    {
1364 
	Al_tagdec * k = al_tagdecs;
1365 
	while (k != (Al_tagdec*)0) {
1366 
	    if (!k->isdeffed || k->iskept) {
1367 
		int capname = capsule_name(&k->idname.name, al_tag_ent);
1368 
		char * n = k->idname.id;
1369 
		current_TDF = lk_externs+al_tag_ent;
1370 
		o_make_linkextern(out_tdfint32(UL(capname)),
1371 
		    o_string_extern({ out_tdfident_bytes(n); }));
1372 
		current_TDF->no++;
1373 
		CONT_STREAM(&units[tld2_unit].tdf,
1374 
		    { int i = k->isused + 2 + 4*k->isdeffed;
1375 
		      out_tdfint32(UL(i)); });
1376 
	    }
1377 
	    k = k->next;
1378 
	}
1379 
    }
1380 
    {
1381 
	int i;
1382 
	TDF caps;
1383 
	add_extra_toks();
1384 
	INIT_TDF(&caps);
1385 
	RESET_TDF(&caps);
1386 
	if (do_pp) success();
1387 
	if (HAS_MAGIC) {
1388 
	    out_basic_int(UL('T'), UI(8));
1389 
	    out_basic_int(UL('D'), UI(8));
1390 
	    out_basic_int(UL('F'), UI(8));
1391 
	    out_basic_int(UL('C'), UI(8));
1392 
	    out_tdfint32(MAJOR_NO);
1393 
	    out_tdfint32(MINOR_NO);
1394 
	    byte_align();
1395 
	}
1396 
	o_make_capsule(
1397 
	    {
1398 
		for(i=0; i<NO_OF_UNITS; i++) {
1399 
		    if(units[i].present) {
1400 
			char* n;
1401 
			n = unit_names[i];
1402 
			LIST_ELEM({ out_tdfident_bytes(n); });
1403 
		    }
1404 
		}
1405 
	    },
1406 
	    {
1407 
		for(i=0; i<NO_OF_ENTITIES; i++) {
1408 
		    char* n;
1409 
		    n = ent_names[i];
1410 
		    LIST_ELEM(
1411 
			o_make_capsule_link(
1412 
			    { out_tdfident_bytes(n);},
1413 
			    out_tdfint32(UL(capsule_names[i]))))
1414 
		}
1415 
	    },
1416 
	    {
1417 
		for(i=0; i<NO_OF_ENTITIES; i++) {
1418 
		    TDF * lks = lk_externs+i;
1419 
		    LIST_ELEM(
1420 
			o_make_extern_link(
1421 
			    { append_TDF(lks,1); current_TDF->no = lks->no; });
1422 
		    )
1423 
		}
1424 
	    },
1425 
	    {
1426 
		for(i=0; i<NO_OF_UNITS; i++) {
1427 
		    if(units[i].present) {
1428 
			LIST_ELEM(
1429 
			    o_make_group(LIST_ELEM(make_unit(i))););
1430 
		    }
1431 
		}
1432 
	    }
1433 
	);
1434 
	make_tdf_file(&caps, out_file);
1435 
    }
1436 
@} ;
1437 
 
1438 
<label1> : () -> () = @{
1439 
    char * n =lex_v.val.name;
1440 
    Labdec * x = find_lab(n);
1441 
    if (x==(Labdec*)0) {
1442 
	x = MALLOC(Labdec);
1443 
	x->idname.id = n; x->idname.name.unit_name = next_label();
1444 
	x->declared = 0;
1445 
	x->next = labdecs; labdecs = x;
1446 
    }
1447 
    g_labdec = x;
1448 
    o_make_label(out_tdfint32(LOCNAME(x->idname)));
1449 
@} ;
1450 
 
1451 
<llist1_dec> : () -> ( thisexp, hold ) = @{
1452 
    @hold = current_TDF;
1453 
    INIT_TDF(&@thisexp);
1454 
    current_TDF = &g_lablist;
1455 
@} ;
1456 
 
1457 
<llist2> : ( thisexp ) -> () = @{
1458 
    if (g_labdec != (Labdec*)0) {
1459 
	if (g_labdec->declared) {
1460 
	    fail("Label %s set twice", g_labdec->idname.id);
1461 
	}
1462 
	g_labdec->declared = 1;
1463 
    }
1464 
    current_TDF = &@thisexp;
1465 
@} ;
1466 
 
1467 
<llist3> : () -> () = @{
1468 
    g_lablist.no = 1;
1469 
@} ;
1470 
 
1471 
<llist4> : () -> () = @{
1472 
    g_lablist.no++;
1473 
@} ;
1474 
 
1475 
<llist5> : ( thisexp, hold ) -> () = @{
1476 
    RESET_TDF(@hold);
1477 
    append_TDF(&@thisexp, 1);
1478 
@} ;
1479 
 
1480 
<lset_o1> : () -> () = @{
1481 
    TDF * hold;
1482 
    SET_TDF(hold, &optlab);
1483 
    if (defaultlab==-1) defaultlab = next_label();
1484 
    o_make_label(out_tdfint32(UL(defaultlab)));
1485 
    RESET_TDF(hold);
1486 
@} ;
1487 
 
1488 
<lset_o2_dec> : () -> ( hold ) = @{
1489 
    SET_TDF(@hold, &optlab);
1490 
    g_labdec = (Labdec*)0;
1491 
    if (defaultlab != -1) { fail("This conditional uses a default jump"); }
1492 
@} ;
1493 
 
1494 
<lset_o3> : ( hold ) -> () = @{
1495 
    if (g_labdec != (Labdec*)0) {
1496 
	if (g_labdec->declared) {
1497 
	    fail("Label %s set twice", g_labdec->idname.id);
1498 
	}
1499 
	g_labdec->declared = 1;
1500 
    }
1501 
    RESET_TDF(@hold);
1502 
@} ;
1503 
 
1504 
<mint1_dec> : () -> ( nt, v ) = @{
1505 
    /* @v uninitialised */
1506 
    @nt = *current_TDF;
1507 
    INIT_TDF(current_TDF);
1508 
@} ;
1509 
 
1510 
<mint2> : ( nt, v ) -> () = @{
1511 
    @v = *current_TDF;
1512 
    INIT_TDF(current_TDF);
1513 
    o_make_int(append_TDF(&@v,1), append_TDF(&@nt,1));
1514 
@} ;
1515 
 
1516 
<nat1> : ( condexp, thenpt, elsept, hold ) -> () = @{
1517 
    RESET_TDF(@hold);
1518 
    o_nat_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
1519 
	       append_TDF(&@elsept,1));
1520 
@} ;
1521 
 
1522 
<nat2> : () -> () = @{
1523 
    o_make_nat(out_tdfint32(intvalue));
1524 
@} ;
1525 
 
1526 
<natopt1> : ( new, hold ) -> () = @{
1527 
    RESET_TDF(@hold);
1528 
    OPTION(append_TDF(&@new,1));
1529 
@} ;
1530 
 
1531 
<natopt_dec> : () -> ( new, hold ) = @{
1532 
    SET_TDF(@hold, &@new);
1533 
@} ;
1534 
 
1535 
<newstr_opt1> : () -> () = @{
1536 
    current_TDF->no=1;
1537 
@} ;
1538 
 
1539 
<newstring1> : () -> () = @{
1540 
    char * s = lex_v.val.name;
1541 
    o_make_string(out_tdfstring_bytes(s, 8, UI(strlen(s))));
1542 
@} ;
1543 
 
1544 
<newstring2> : ( condexp, thenpt, elsept, hold ) -> () = @{
1545 
    RESET_TDF(@hold);
1546 
    o_string_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
1547 
		  append_TDF(&@elsept,1));
1548 
@} ;
1549 
 
1550 
<ntest1> : ( condexp, thenpt, elsept, hold ) -> () = @{
1551 
    RESET_TDF(@hold);
1552 
    o_ntest_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
1553 
		 append_TDF(&@elsept,1));
1554 
@} ;
1555 
 
1556 
<ntest2> : () -> () = @{
1557 
    char * n = lex_v.val.name;
1558 
    if (strcmp(n,"!<")==0) { o_not_less_than; }
1559 
    else if (strcmp(n,"!<=")==0) { o_not_less_than_or_equal; }
1560 
    else if (strcmp(n,"!=")==0) { o_not_equal; }
1561 
    else if (strcmp(n,"!>")==0) { o_not_greater_than; }
1562 
    else if (strcmp(n,"!>=")==0) { o_not_greater_than_or_equal; }
1563 
    else if (strcmp(n,"!Comparable")==0) { o_not_comparable; }
1564 
    else if (strcmp(n,"<")==0) { o_less_than; }
1565 
    else if (strcmp(n,"<=")==0) { o_less_than_or_equal; }
1566 
    else if (strcmp(n,"==")==0) { o_equal; }
1567 
    else if (strcmp(n,">")==0) { o_greater_than; }
1568 
    else if (strcmp(n,">=")==0) { o_greater_than_or_equal; }
1569 
    else if (strcmp(n,"Comparable")==0) { o_comparable; }
1570 
    else { fail("%s is not a comparison", n); }
1571 
@} ;
1572 
 
1573 
<offexpl1> : () -> () = @{
1574 
    current_TDF->no = 2;
1575 
@} ;
1576 
 
1577 
<offexpl2> : () -> () = @{
1578 
    current_TDF->no+=2;
1579 
@} ;
1580 
 
1581 
<otagel1> : () -> () = @{
1582 
    current_TDF->no = 1;
1583 
@} ;
1584 
 
1585 
<otagel2> : () -> () = @{
1586 
    current_TDF->no++;
1587 
@} ;
1588 
 
1589 
<otagel_opt1> : () -> () = @{
1590 
    current_TDF->no = 0;
1591 
@} ;
1592 
 
1593 
<otagexp1_dec> : () -> ( e, hold ) = @{
1594 
    SET_TDF(@hold, &@e);
1595 
@} ;
1596 
 
1597 
<otagexp2> : ( e, hold ) -> () = @{
1598 
    RESET_TDF(@hold);
1599 
    o_make_otagexp( {}, append_TDF(&@e,1));
1600 
@} ;
1601 
 
1602 
<otagexp3> : ( e, hold ) -> () = @{
1603 
    char* n = lex_v.val.name;
1604 
    Tagdec * x = find_tag(n);
1605 
    if (x != (Tagdec*)0) { fail("Tag %s declared twice", n); }
1606 
    x = MALLOC(Tagdec); x->isdeffed = 1; x->hassh=0; x->iskept=0;
1607 
    NEW_IDNAME(x->idname, n, tag_ent);
1608 
    x->isvar = 1;
1609 
    x->next = g_app_tags; g_app_tags = x;
1610 
    RESET_TDF(@hold);
1611 
    o_make_otagexp( OPTION(make_tag(&x->idname.name)),append_TDF(&@e,1));
1612 
@} ;
1613 
 
1614 
<plude1> : () -> () = @{
1615 
    o_make_top;
1616 
@} ;
1617 
 
1618 
<proc_def1> : ( tfexp, hold ) -> () = @{
1619 
    RESET_TDF(@hold);
1620 
    SET_TDF(@hold, &@tfexp);
1621 
@} ;
1622 
 
1623 
<proc_def2> : ( tfexp, sigopt, hold, x, n, is_deced ) -> () = @{
1624 
    RESET_TDF(@hold);
1625 
    o_make_id_tagdef(out_tdfint32(UL(local_name(&@x->idname.name, tag_ent))),
1626 
	if (@sigopt.no !=0) { OPTION(append_TDF(&@sigopt, @is_deced)); },
1627 
      append_TDF(&@tfexp, 1));
1628 
    INC_LIST;
1629 
    SELECT_UNIT(tagdec_unit);
1630 
    if (!@is_deced) {
1631 
	o_make_id_tagdec(out_tdfint32(UL(non_local(&@x->idname.name,tag_ent))),
1632 
	    {},
1633 
	    if (@sigopt.no !=0) { OPTION(append_TDF(&@sigopt, 1)); },
1634 
	    o_proc);
1635 
	INC_LIST;
1636 
    }
1637 
    @x->isdeffed=1;
1638 
    if (!@is_deced) {@x->next = tagdecs; tagdecs = @x;}
1639 
@} ;
1640 
 
1641 
<query_type1> : () -> () = @{
1642 
    query_t = lex_query;
1643 
@} ;
1644 
 
1645 
<query_type2> : () -> () = @{
1646 
    query_t = lex_float__query;
1647 
@} ;
1648 
 
1649 
<query_type3> : () -> () = @{
1650 
    query_t = lex_ptr__query;
1651 
@} ;
1652 
 
1653 
<query_type4> : () -> () = @{
1654 
    query_t = lex_proc__query;
1655 
@} ;
1656 
 
1657 
<query_type5> : () -> () = @{
1658 
    query_t = lex_offset__query;
1659 
@} ;
1660 
 
1661 
<range1_dec> : () -> ( hold ) = @{
1662 
    SET_TDF(@hold, &g_lower);
1663 
@} ;
1664 
 
1665 
<range2> : ( hold ) -> () = @{
1666 
    RESET_TDF(@hold);
1667 
    g_upper = g_lower;
1668 
    g_has_upper=0;
1669 
@} ;
1670 
 
1671 
<range3> : ( hold ) -> () = @{
1672 
    RESET_TDF(@hold);
1673 
    SET_TDF(@hold, &g_upper);
1674 
@} ;
1675 
 
1676 
<range4> : ( hold ) -> () = @{
1677 
    RESET_TDF(@hold);
1678 
    g_has_upper=1;
1679 
@} ;
1680 
 
1681 
<rllist1_dec> : () -> ( labx, hold ) = @{
1682 
    SET_TDF(@hold,&@labx);
1683 
@} ;
1684 
 
1685 
<rllist2> : ( labx, hold ) -> () = @{
1686 
    RESET_TDF(@hold);
1687 
    o_make_caselim(append_TDF(&@labx,1),
1688 
		   append_TDF(&g_lower, g_has_upper),
1689 
		   append_TDF(&g_upper,1));
1690 
    current_TDF->no = 1;
1691 
@} ;
1692 
 
1693 
<rllist3> : ( labx, hold ) -> () = @{
1694 
    RESET_TDF(@hold);
1695 
    o_make_caselim(append_TDF(&@labx,1),
1696 
		   append_TDF(&g_lower, g_has_upper),
1697 
		   append_TDF(&g_upper,1));
1698 
@} ;
1699 
 
1700 
<rllist4> : () -> () = @{
1701 
    current_TDF->no++;
1702 
@} ;
1703 
 
1704 
<rmode1> : ( condexp, thenpt, elsept, hold ) -> () = @{
1705 
    RESET_TDF(@hold);
1706 
    o_rounding_mode_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
1707 
			 append_TDF(&@elsept,1));
1708 
@} ;
1709 
 
1710 
<rmodeopt1> : () -> () = @{
1711 
    o_to_nearest;
1712 
@} ;
1713 
 
1714 
<shape1> : ( condexp, thenpt, elsept, hold ) -> () = @{
1715 
    RESET_TDF(@hold);
1716 
    o_shape_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
1717 
		 append_TDF(&@elsept,1));
1718 
@} ;
1719 
 
1720 
<shapechar> : () -> () = @{
1721 
    Name * shtok = tokforcharsh(issigned);
1722 
    o_shape_apply_token(make_tok(shtok), {});
1723 
@} ;
1724 
 
1725 
<shapedouble> : () -> () = @{
1726 
    Name * shtok = tokfordoublesh();
1727 
    o_shape_apply_token(make_tok(shtok), {});
1728 
@} ;
1729 
 
1730 
<shapefloat> : () -> () = @{
1731 
    Name * shtok = tokforfloatsh();
1732 
    o_shape_apply_token(make_tok(shtok), {});
1733 
@} ;
1734 
 
1735 
<shapeint> : () -> () = @{
1736 
    Name * shtok = tokforintsh(issigned);
1737 
    o_shape_apply_token(make_tok(shtok), {});
1738 
@} ;
1739 
 
1740 
<shapelong> : () -> () = @{
1741 
    Name * shtok = tokforlongsh(issigned);
1742 
    o_shape_apply_token(make_tok(shtok), {});
1743 
@} ;
1744 
 
1745 
<shapeptr2> : ( sh, hold ) -> () = @{
1746 
    RESET_TDF(@hold);
1747 
    o_pointer(o_alignment(append_TDF(&@sh,1)));
1748 
@} ;
1749 
 
1750 
<shapeshort> : () -> () = @{
1751 
    Name * shtok = tokforshortsh(issigned);
1752 
    o_shape_apply_token(make_tok(shtok), {});
1753 
@} ;
1754 
 
1755 
<shapetok2> : ( place, sh, hold, cu ) -> () = @{
1756 
    RESET_TDF(@hold);
1757 
    o_make_tokdef(out_tdfint32(UL(g_shtokname->unit_name)), {},
1758 
		  o_token_def(o_shape, {}, append_TDF(&@sh, 1)));
1759 
    INC_LIST;
1760 
    current_Unit = @cu;
1761 
    RESET_TDF(@place);
1762 
@} ;
1763 
 
1764 
<shapetokchar> : () -> () = @{
1765 
    * g_shtokname = *(tokforcharsh(issigned));
1766 
@} ;
1767 
 
1768 
<shapetokint> : () -> () = @{
1769 
    * g_shtokname = *(tokforintsh(issigned));
1770 
@} ;
1771 
 
1772 
<shapetoklong> : () -> () = @{
1773 
    * g_shtokname = *(tokforlongsh(issigned));
1774 
@} ;
1775 
 
1776 
<shptr1_dec> : () -> ( sh, hold ) = @{
1777 
    SET_TDF(@hold, &@sh);
1778 
@} ;
1779 
 
1780 
<shtok1_dec> : () -> ( place, sh, hold, cu ) = @{
1781 
    @place = current_TDF;
1782 
    @cu = current_Unit;
1783 
    select_tokdef_unit();
1784 
    * g_shtokname = next_name(tok_ent);
1785 
    SET_TDF(@hold, &@sh);
1786 
@} ;
1787 
 
1788 
<shtokdb> : () -> () = @{
1789 
    * g_shtokname = *(tokfordoublesh());
1790 
@} ;
1791 
 
1792 
<shtokflt> : () -> () = @{
1793 
    * g_shtokname = *(tokforfloatsh());
1794 
@} ;
1795 
 
1796 
<shtokshrt> : () -> () = @{
1797 
    * g_shtokname = *(tokforshortsh(issigned));
1798 
@} ;
1799 
 
1800 
<signed_nat1> : ( condexp, thenpt, elsept, hold ) -> () = @{
1801 
    RESET_TDF(@hold);
1802 
    o_signed_nat_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
1803 
		      append_TDF(&@elsept,1));
1804 
@} ;
1805 
 
1806 
<signed_nat2> : () -> () = @{
1807 
    o_make_signed_nat(out_tdfbool(0), out_tdfint32(intvalue));
1808 
@} ;
1809 
 
1810 
<signed_nat3> : () -> () = @{
1811 
    o_make_signed_nat(out_tdfbool(1), out_tdfint32(intvalue));
1812 
@} ;
1813 
 
1814 
<signed_nat4> : () -> () = @{
1815 
    o_make_signed_nat(out_tdfbool(0), out_tdfint32(cLINE));
1816 
@} ;
1817 
 
1818 
<signed_nat5_dec> : () -> ( nt, hold ) = @{
1819 
    SET_TDF(@hold, &@nt);
1820 
@} ;
1821 
 
1822 
<signed_nat6> : ( nt, hold ) -> () = @{
1823 
    RESET_TDF(@hold);
1824 
    o_snat_from_nat(o_true, append_TDF(&@nt,1));
1825 
@} ;
1826 
 
1827 
<signed_nat7_dec> : () -> ( nt, hold ) = @{
1828 
    SET_TDF(@hold, &@nt);
1829 
    if (strcmp(lex_v.val.name, "+")) fail("Only + or - on NATs");
1830 
@} ;
1831 
 
1832 
<signed_nat8> : ( nt, hold ) -> () = @{
1833 
    RESET_TDF(@hold);
1834 
    o_snat_from_nat(o_false, append_TDF(&@nt,1));
1835 
@} ;
1836 
 
1837 
<signedornot1> : () -> () = @{
1838 
    issigned = 1;
1839 
@} ;
1840 
 
1841 
<signedornot2> : () -> () = @{
1842 
    issigned = 0;
1843 
@} ;
1844 
 
1845 
<sizeexp2> : ( sh, hold ) -> () = @{
1846 
    RESET_TDF(@hold);
1847 
    o_offset_pad(o_alignment(append_TDF(&@sh, 0)),
1848 
		 o_shape_offset(append_TDF(&@sh, 1)));
1849 
@} ;
1850 
 
1851 
<sortname1> : () -> () = @{
1852 
    g_sname.sort = lex_v.t;
1853 
@} ;
1854 
 
1855 
<sortname2> : () -> () = @{
1856 
    if(g_sname.sort == token_sort) {
1857 
	fail("Token pars require result and parameter sorts");
1858 
    }
1859 
    g_sname.toksort= (TokSort*)0;
1860 
@} ;
1861 
 
1862 
<sortname3_dec> : () -> ( x, temp, old_tokpars ) = @{
1863 
    /* @temp uninitialised */
1864 
    @old_tokpars = g_tokpars;
1865 
    @x = g_sname;
1866 
    if (g_sname.sort != token_sort) {
1867 
	fail("Only token pars require result and parameter sorts");
1868 
    }
1869 
@} ;
1870 
 
1871 
<sortname4> : ( temp ) -> () = @{
1872 
    @temp = g_tokpars;
1873 
@} ;
1874 
 
1875 
<sortname5> : ( x, temp, old_tokpars ) -> () = @{
1876 
    TokSort * ts = MALLOC(TokSort);
1877 
    ts->ressort = g_sname;
1878 
    ts->pars = @temp;
1879 
    g_tokpars = @old_tokpars;
1880 
    @x.toksort = ts;
1881 
    g_sname = @x;
1882 
@} ;
1883 
 
1884 
<snl1> : () -> () = @{
1885 
    g_tokpars = MALLOC(Tokpar);
1886 
    g_tokpars->par = g_sname;
1887 
    g_tokpars->next = (Tokpar*)0;
1888 
@} ;
1889 
 
1890 
<snl2_dec> : () -> ( tmp ) = @{
1891 
    @tmp = g_sname;
1892 
@} ;
1893 
 
1894 
<snl3> : ( tmp ) -> () = @{
1895 
    Tokpar * x = MALLOC(Tokpar);
1896 
    x->par = @tmp;
1897 
    x->next = g_tokpars;
1898 
    g_tokpars = x;
1899 
@} ;
1900 
 
1901 
<strtr1> : () -> () = @{
1902 
    o_make_top;
1903 
@} ;
1904 
 
1905 
<struct1_dec> : () -> ( x ) = @{
1906 
    char * n = lex_v.val.name;
1907 
    @x = find_tok(n);
1908 
    SELECT_UNIT(tokdef_unit);
1909 
    if (@x!=(Tokdec*)0) fail("Struct name %s must be unique", n);
1910 
    @x = MALLOC(Tokdec); NEW_IDNAME(@x->idname, n, tok_ent);
1911 
    @x->sort.ressort.sort = shape_sort; @x->sort.pars = (Tokpar*)0;
1912 
    @x->isdeffed = 1; @x->isused=0; @x->iskept=0;
1913 
    g_lastfield = -1;
1914 
@} ;
1915 
 
1916 
<struct2> : ( x ) -> () = @{
1917 
    o_make_tokdef(out_tdfint32(LOCNAME(@x->idname)), {},
1918 
	o_token_def(o_shape, {},
1919 
	    o_compound(o_offset_add(
1920 
		o_exp_apply_token(
1921 
		    o_make_tok(out_tdfint32(UL(g_lastfield))),{}),
1922 
		o_shape_offset(append_TDF(&g_lastshape, 1))))))
1923 
    INC_LIST;
1924 
    @x->next = tokdecs;
1925 
    tokdecs = @x;
1926 
@} ;
1927 
 
1928 
<szexp1_dec> : () -> ( sh, hold ) = @{
1929 
    SET_TDF(@hold, &@sh);
1930 
@} ;
1931 
 
1932 
<tag1> : () -> () = @{
1933 
    char * n =lex_v.val.name;
1934 
    Tagdec * x = find_tag(n);
1935 
    if (x == (Tagdec*)0) { fail("Ident %s not declared", n); }
1936 
    x->isused = 1;
1937 
    make_tag(&x->idname.name);
1938 
@} ;
1939 
 
1940 
<tag_dec1_dec> : () -> ( tdaccopt, sigopt, hold, x ) = @{
1941 
    /* @sigopt uninitialised */
1942 
    char * n =lex_v.val.name;
1943 
    @x = find_tag(n);
1944 
    if (@x != (Tagdec*)0) fail("Tag %s declared twice", n);
1945 
    SELECT_UNIT(tagdec_unit);
1946 
    @x = MALLOC(Tagdec); NEW_IDNAME(@x->idname, n, tag_ent);
1947 
    @x->isdeffed = 0; @x->hassh = 1; @x->iskept=0; @x->iscommon=0;
1948 
    @x->isused = 0;
1949 
    SET_TDF(@hold, &@tdaccopt);
1950 
@} ;
1951 
 
1952 
<tag_dec2> : ( x ) -> () = @{
1953 
    g_shtokname = &@x->sh.shtok;
1954 
@} ;
1955 
 
1956 
<tag_dec3> : ( tdaccopt, sigopt, hold, x ) -> () = @{
1957 
    RESET_TDF(@hold);
1958 
    o_make_var_tagdec(out_tdfint32(LOCNAME(@x->idname)),
1959 
	if (@tdaccopt.no !=0) { OPTION(append_TDF(&@tdaccopt, 1)); },
1960 
	if (@sigopt.no !=0) { OPTION(append_TDF(&@sigopt, 1)); },
1961 
	o_shape_apply_token(make_tok(&@x->sh.shtok), {}));
1962 
    INC_LIST;
1963 
    @x->next = tagdecs;
1964 
    @x->isvar = 1;
1965 
    tagdecs = @x;
1966 
@} ;
1967 
 
1968 
<tag_dec4> : ( tdaccopt, sigopt, hold, x ) -> () = @{
1969 
    RESET_TDF(@hold);
1970 
    o_make_id_tagdec(out_tdfint32(LOCNAME(@x->idname)),
1971 
	if (@tdaccopt.no !=0) { OPTION(append_TDF(&@tdaccopt, 1)); },
1972 
	if (@sigopt.no !=0) { OPTION(append_TDF(&@sigopt, 1)); },
1973 
	o_shape_apply_token(make_tok(&@x->sh.shtok), {}));
1974 
    INC_LIST;
1975 
    @x->next = tagdecs;
1976 
    @x->isvar = 0;
1977 
    tagdecs = @x;
1978 
@} ;
1979 
 
1980 
<tag_dec5> : ( tdaccopt, sigopt, hold, x ) -> () = @{
1981 
    RESET_TDF(@hold);
1982 
    @x->iscommon = 1;
1983 
    o_common_tagdec(out_tdfint32(LOCNAME(@x->idname)),
1984 
	if (@tdaccopt.no !=0) { OPTION(append_TDF(&@tdaccopt, 1)); },
1985 
	if (@sigopt.no !=0) { OPTION(append_TDF(&@sigopt, 1)); },
1986 
	o_shape_apply_token(make_tok(&@x->sh.shtok), {}));
1987 
    INC_LIST;
1988 
    @x->next = tagdecs;
1989 
    @x->isvar = 1;
1990 
    tagdecs = @x;
1991 
@} ;
1992 
 
1993 
<tag_dec6> : ( sigopt, hold ) -> () = @{
1994 
    RESET_TDF(@hold);
1995 
    SET_TDF(@hold, &@sigopt);
1996 
@} ;
1997 
 
1998 
<tag_def10> : ( x ) -> () = @{
1999 
    o_make_value(o_shape_apply_token(make_tok(&@x->sh.shtok), {}));
2000 
@} ;
2001 
 
2002 
<tag_def12> : ( tfexp, hold, x, is_deced, v, s ) -> () = @{
2003 
    RESET_TDF(@hold);
2004 
    o_make_var_tagdef(out_tdfint32(UL(local_name(&@x->idname.name, tag_ent))),
2005 
	{}, {}, append_TDF(&@tfexp, 1));
2006 
    INC_LIST;
2007 
    SELECT_UNIT(tagdec_unit);
2008 
    if (!@is_deced) {
2009 
	o_make_var_tagdec(out_tdfint32(UL(non_local(&@x->idname.name,tag_ent))),
2010 
	    {}, {},
2011 
	    o_nof(o_make_nat(out_tdfint32(UL(strlen(@s)+1))),
2012 
		o_integer(append_TDF(&@v, 0))));
2013 
       INC_LIST;
2014 
    }
2015 
    @x->isdeffed=1;
2016 
    if (!@is_deced) { @x->next = tagdecs; tagdecs = @x; }
2017 
@} ;
2018 
 
2019 
<tag_def1_dec> : () -> ( tfexp, sigopt, hold, x, n, is_deced ) = @{
2020 
    /* @tfexp uninitialised */
2021 
    @n =lex_v.val.name;
2022 
    @x = find_tag(@n);
2023 
    SELECT_UNIT(tagdef_unit);
2024 
    if(@x!= (Tagdec*)0) {
2025 
	if (@x->isdeffed && !@x->iscommon) fail("Tag %s defined twice", @n);
2026 
	if (!@x->isvar) fail("Tag %s declared as non-variable", @n);
2027 
	@is_deced = 1;
2028 
    } else {
2029 
	@x = MALLOC(Tagdec);
2030 
	@x->hassh = 0; @x->isvar=1; @x->iskept=0; @x->iscommon = 0;
2031 
	@x->isused=0;
2032 
	NEW_IDNAME(@x->idname, @n, tag_ent);
2033 
	@is_deced=0;
2034 
    }
2035 
    SET_TDF(@hold, &@sigopt);
2036 
@} ;
2037 
 
2038 
<tag_def2> : ( tfexp, hold, x, n ) -> () = @{
2039 
    RESET_TDF(@hold);
2040 
    if (!@x->hassh) fail("No declaration shape for %s", @n);
2041 
    SET_TDF(@hold, &@tfexp);
2042 
@} ;
2043 
 
2044 
<tag_def3> : ( tfexp, sigopt, hold, x ) -> () = @{
2045 
    RESET_TDF(@hold);
2046 
    o_make_var_tagdef(out_tdfint32(UL(non_local(&@x->idname.name, tag_ent))),
2047 
	{},
2048 
	if (@sigopt.no !=0) { OPTION(append_TDF(&@sigopt, 1)); },
2049 
	append_TDF(&@tfexp, 1));
2050 
    INC_LIST;
2051 
    @x->isdeffed = 1;
2052 
@} ;
2053 
 
2054 
<tag_def4> : ( hold, x, n ) -> () = @{
2055 
    RESET_TDF(@hold);
2056 
    if (@x->hassh) fail("Two declaration shapes for %s", @n);
2057 
    g_shtokname = &@x->sh.shtok;
2058 
@} ;
2059 
 
2060 
<tag_def5> : ( tfexp, hold ) -> () = @{
2061 
    SET_TDF(@hold, &@tfexp);
2062 
@} ;
2063 
 
2064 
<tag_def6> : ( tfexp, sigopt, hold, x, is_deced ) -> () = @{
2065 
    RESET_TDF(@hold);
2066 
    o_make_var_tagdef(out_tdfint32(UL(local_name(&@x->idname.name, tag_ent))),
2067 
	{},
2068 
	if (@sigopt.no !=0 ) { OPTION(append_TDF(&@sigopt, @is_deced)); },
2069 
	append_TDF(&@tfexp, 1));
2070 
    INC_LIST;
2071 
    SELECT_UNIT(tagdec_unit);
2072 
    if (!@is_deced) {
2073 
	o_make_var_tagdec(out_tdfint32(UL(non_local(&@x->idname.name,tag_ent))),
2074 
	    {},
2075 
	    if (@sigopt.no !=0 ) { OPTION(append_TDF(&@sigopt, 1)); },
2076 
	    o_shape_apply_token(make_tok(&@x->sh.shtok), {}));
2077 
	INC_LIST;
2078 
    }
2079 
    @x->isdeffed=1; @x->hassh =1;
2080 
    if (!@is_deced) { @x->next = tagdecs; tagdecs = @x; }
2081 
@} ;
2082 
 
2083 
<tag_def7_dec> : () -> ( tfexp, sigopt, hold, x, n, is_deced ) = @{
2084 
    /* @tfexp uninitialised */
2085 
    @n =lex_v.val.name;
2086 
    @x = find_tag(@n);
2087 
    SELECT_UNIT(tagdef_unit);
2088 
    if(@x!= (Tagdec*)0) {
2089 
	if (@x->isdeffed && !@x->iscommon) fail("Tag %s defined twice", @n);
2090 
	if (@x->isvar) fail("Tag %s declared as variable", @n);
2091 
	@is_deced = 1;
2092 
    } else {
2093 
	@x = MALLOC(Tagdec);
2094 
	@x->hassh = 0; @x->isvar=0; @x->iskept=0; @x->iscommon = 0;
2095 
	@x->isused = 0;
2096 
	NEW_IDNAME(@x->idname, @n, tag_ent);
2097 
	@is_deced = 0;
2098 
    }
2099 
    SET_TDF(@hold, &@sigopt);
2100 
@} ;
2101 
 
2102 
<tag_def8> : ( tfexp, sigopt, hold, x ) -> () = @{
2103 
    RESET_TDF(@hold);
2104 
    o_make_id_tagdef(out_tdfint32(UL(non_local(&@x->idname.name, tag_ent))),
2105 
	if (@sigopt.no !=0) { OPTION(append_TDF(&@sigopt, 1)); },
2106 
	append_TDF(&@tfexp, 1));
2107 
    INC_LIST;
2108 
    @x->isdeffed = 1;
2109 
@} ;
2110 
 
2111 
<tag_def9> : ( tfexp, sigopt, hold, x, is_deced ) -> () = @{
2112 
    RESET_TDF(@hold);
2113 
    o_make_id_tagdef(out_tdfint32(UL(local_name(&@x->idname.name, tag_ent))),
2114 
	if (@sigopt.no !=0) { OPTION(append_TDF(&@sigopt, @is_deced)); },
2115 
	append_TDF(&@tfexp, 1));
2116 
    INC_LIST;
2117 
    SELECT_UNIT(tagdec_unit);
2118 
    if (!@is_deced) {
2119 
	o_make_id_tagdec(out_tdfint32(UL(non_local(&@x->idname.name,tag_ent))),
2120 
	    {},
2121 
	    if (@sigopt.no !=0) { OPTION(append_TDF(&@sigopt, 1)); },
2122 
	    o_shape_apply_token(make_tok(&@x->sh.shtok), {}));
2123 
	INC_LIST;
2124 
    }
2125 
    @x->isdeffed=1; @x->hassh =1;
2126 
    if (!@is_deced) { @x->next = tagdecs; tagdecs = @x; }
2127 
@} ;
2128 
 
2129 
<tagsa1_dec> : () -> ( accopt, hold, x, has_vis ) = @{
2130 
    /* @has_vis uninitialised */
2131 
    char * n =lex_v.val.name;
2132 
    @x = find_tag(n);
2133 
    if (@x != (Tagdec*)0) fail("Ident %s already declared", n);
2134 
    @x = MALLOC(Tagdec);
2135 
    @x->hassh = 2; @x->isvar =1; @x->isdeffed = 1; @x->iskept=0;
2136 
    NEW_IDNAME(@x->idname, n, tag_ent);
2137 
    g_has_vis =0;
2138 
    SET_TDF(@hold, &@accopt);
2139 
@} ;
2140 
 
2141 
<tagshacc2> : ( hold, x, has_vis ) -> () = @{
2142 
    RESET_TDF(@hold);
2143 
    SET_TDF(@hold, &@x->sh.tdfsh);
2144 
    @has_vis = g_has_vis;
2145 
@} ;
2146 
 
2147 
<tagshacc3> : ( accopt, hold, x, has_vis ) -> () = @{
2148 
    RESET_TDF(@hold);
2149 
    o_make_tagshacc( append_TDF(&@x->sh.tdfsh, 0),
2150 
	if(@accopt.no != 0) {OPTION(append_TDF(&@accopt,1));},
2151 
	make_tag(&@x->idname.name));
2152 
    if (@has_vis) {
2153 
	Tagdec * y = MALLOC(Tagdec);
2154 
	*y = *@x;
2155 
	y->next = tagdecs;
2156 
	tagdecs = y;
2157 
    }
2158 
    @x->next = localdecs;
2159 
    localdecs = @x;
2160 
@} ;
2161 
 
2162 
<tagshacc_l1> : () -> () = @{
2163 
    current_TDF->no =0;
2164 
@} ;
2165 
 
2166 
<tagshacc_l2> : () -> () = @{
2167 
    current_TDF->no++;
2168 
@} ;
2169 
 
2170 
<tcall1_dec> : () -> ( fn ) = @{
2171 
    @fn = *current_TDF;
2172 
    INIT_TDF(current_TDF);
2173 
@} ;
2174 
 
2175 
<tcall2> : ( fn ) -> () = @{
2176 
    TDF cees;
2177 
    cees = *current_TDF;
2178 
    INIT_TDF(current_TDF);
2179 
    o_tail_call(do_procprops(g_ce_v*2),
2180 
		append_TDF(&@fn,1), append_TDF(&cees,1));
2181 
@} ;
2182 
 
2183 
<tgdef10_dec> : ( hold ) -> ( v ) = @{
2184 
    RESET_TDF(@hold);
2185 
    SET_TDF(@hold, &@v);
2186 
@} ;
2187 
 
2188 
<tgdef11_dec> : ( tfexp, hold, x, n, v ) -> ( s ) = @{
2189 
    @s = lex_v.val.name;
2190 
    if (@x->hassh) fail("Two declaration shapes for %s", @n);
2191 
    RESET_TDF(@hold);
2192 
    SET_TDF(@hold, &@tfexp);
2193 
    o_make_nof_int(append_TDF(&@v, 0),
2194 
	o_make_string(out_tdfstring_bytes(@s, 8, UI(strlen(@s)+1))));
2195 
@} ;
2196 
 
2197 
<tmode1> : ( condexp, thenpt, elsept, hold ) -> () = @{
2198 
    RESET_TDF(@hold);
2199 
    o_transfer_mode_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
2200 
			 append_TDF(&@elsept,1));
2201 
@} ;
2202 
 
2203 
<tok1> : () -> () = @{
2204 
    Tokdec * td = lex_v.val.tokname;
2205 
    if (td->isparam) {
2206 
	o_token_apply_token(make_tok(&td->idname.name), {});
2207 
    } else {
2208 
	make_tok(&td->idname.name);
2209 
    }
2210 
    /* token should only be expanded as parameter of a token */
2211 
@} ;
2212 
 
2213 
<tok2_dec> : () -> ( holdtd ) = @{
2214 
    @holdtd = g_tok_defn;
2215 
@} ;
2216 
 
2217 
<tok3> : ( holdtd ) -> () = @{
2218 
    o_use_tokdef(append_TDF(&g_tok_defn,1));
2219 
    g_tok_defn = @holdtd;
2220 
@} ;
2221 
 
2222 
<tok_dec1_dec> : () -> ( sigopt, hold, x ) = @{
2223 
    char *n = lex_v.val.name;
2224 
    @x = find_tok(n);
2225 
    if (@x != (Tokdec *)0) fail("Token %s declared twice", n);
2226 
    SELECT_UNIT(tokdec_unit);
2227 
    @x = MALLOC(Tokdec);
2228 
    NEW_IDNAME(@x->idname, n, tok_ent);
2229 
    SET_TDF(@hold, &@sigopt);
2230 
@} ;
2231 
 
2232 
<tok_dec2> : ( sigopt, hold, x ) -> () = @{
2233 
    RESET_TDF(@hold);
2234 
    @x->sort.ressort = g_sname;
2235 
    @x->sort.pars = g_tokpars;
2236 
    @x->next = tokdecs;
2237 
    @x->isdeffed = 0; @x->isused = 0; @x->iskept=0; @x->isparam=0;
2238 
    tokdecs = @x;
2239 
    o_make_tokdec(out_tdfint32(LOCNAME(@x->idname)),
2240 
	if (@sigopt.no != 0) { OPTION(append_TDF(&@sigopt, 1)); },
2241 
	out_toksort(&@x->sort));
2242 
    INC_LIST;
2243 
@} ;
2244 
 
2245 
<tok_def0> : () -> () = @{
2246 
    search_for_toks = 0;
2247 
@} ;
2248 
 
2249 
<tok_def1_dec> : () -> ( holdtd, sigopt, hold, x, is_deced ) = @{
2250 
    char *n = lex_v.val.name;
2251 
    @x = find_tok(n);
2252 
    @holdtd = g_tok_defn;
2253 
    SELECT_UNIT(tokdef_unit);
2254 
    search_for_toks = 1;
2255 
    if (@x != (Tokdec *)0) {
2256 
	if (@x->isdeffed) fail("Token %s defined twice", n);
2257 
	@is_deced = 1;
2258 
    } else {
2259 
	@x = MALLOC(Tokdec);
2260 
	NEW_IDNAME(@x->idname, n, tok_ent);
2261 
	@is_deced = 0;
2262 
    }
2263 
    SET_TDF(@hold, &@sigopt);
2264 
@} ;
2265 
 
2266 
<tok_def2> : ( holdtd, sigopt, hold, x, is_deced ) -> () = @{
2267 
    RESET_TDF(@hold);
2268 
    @x->sort = g_toksort;
2269 
    @x->isdeffed =1; @x->iskept=0; @x->isparam = 0;
2270 
    o_make_tokdef(out_tdfint32(UL(local_name(&@x->idname.name,tok_ent))),
2271 
	if (@sigopt.no != 0) { OPTION(append_TDF(&@sigopt, 1)); },
2272 
	append_TDF(&g_tok_defn, 1));
2273 
    INC_LIST;
2274 
    if (!@is_deced) { @x->next = tokdecs; tokdecs = @x; @x->isused=0; }
2275 
    g_tok_defn = @holdtd;
2276 
@} ;
2277 
 
2278 
<tok_dn1_dec> : () -> ( old_tokformals ) = @{
2279 
    @old_tokformals = g_tokformals;
2280 
@} ;
2281 
 
2282 
<tok_dn2> : ( old_tokformals ) -> () = @{
2283 
    Tokdec * old_tokdecs = tokdecs;
2284 
    Tokdec * tokformals = g_tokformals;
2285 
    TDF * hold = current_TDF;
2286 
    Tokpar * tp = (Tokpar*)0;
2287 
    Sort sn;
2288 
    Tokdec * tfrev = (Tokdec*)0;
2289 
    while (g_tokformals != (Tokdec*)0) { /* the wrong way round!! */
2290 
	Tokdec * x = MALLOC(Tokdec);
2291 
	*x = *g_tokformals;
2292 
	x->next = tfrev;
2293 
	tfrev = x;
2294 
	g_tokformals = g_tokformals->next;
2295 
    }
2296 
    sn = g_sname;
2297 
    current_TDF = &g_tok_defn;
2298 
    INIT_TDF(current_TDF);
2299 
    o_token_def( out_sort(&sn),
2300 
	{
2301 
	    while(tfrev != (Tokdec*)0) {
2302 
		Tokdec * x = tfrev->next;
2303 
		LIST_ELEM(
2304 
		    o_make_tokformals(
2305 
			out_sort(&tfrev->sort.ressort),
2306 
			out_tdfint32(LOCNAME(tfrev->idname))));
2307 
		tfrev->isparam = 1;
2308 
		tfrev->next = tokdecs;
2309 
		tokdecs = tfrev;
2310 
		tfrev = x;
2311 
	    }
2312 
	},
2313 
	analyse_sort(sn.sort));
2314 
    g_toksort.ressort = sn;
2315 
    while (tokformals != (Tokdec*)0) {
2316 
	Tokpar * p = MALLOC(Tokpar);
2317 
	p->par = tokformals->sort.ressort;
2318 
	p->next = tp;
2319 
	tokformals = tokformals->next;
2320 
	tp = p;
2321 
    }
2322 
    g_toksort.pars = tp;
2323 
    RESET_TDF(hold);
2324 
    tokdecs = old_tokdecs;
2325 
    g_tokformals = @old_tokformals;
2326 
@} ;
2327 
 
2328 
<tok_fml1_dec> : () -> ( x ) = @{
2329 
    char * n = lex_v.val.name;
2330 
    @x = find_tok(n);
2331 
    if (@x!=(Tokdec*)0) fail("Token parameter name %s must be unique", n);
2332 
    @x = MALLOC(Tokdec); NEW_IDNAME(@x->idname, n, tok_ent);
2333 
    @x->isdeffed = 1; @x->isused = 0; @x->iskept=0;
2334 
    @x->next = (Tokdec*)0;
2335 
@} ;
2336 
 
2337 
<tok_fml2> : ( x ) -> () = @{
2338 
    @x->sort.ressort = g_sname;
2339 
    @x->sort.pars = (Tokpar*)0;  /* no pars in formal pars */
2340 
    g_tokformals = @x;
2341 
@} ;
2342 
 
2343 
<tok_fml3> : ( x ) -> () = @{
2344 
    @x->sort.ressort = g_sname;
2345 
    @x->sort.pars = (Tokpar*)0; /* no pars in formal pars */
2346 
    @x->next = g_tokformals;
2347 
    g_tokformals = @x;
2348 
@} ;
2349 
 
2350 
<tok_fml_opt1> : () -> () = @{
2351 
    g_tokpars = (Tokpar*)0;
2352 
@} ;
2353 
 
2354 
<untidy1> : () -> () = @{
2355 
    g_unt = 0;
2356 
@} ;
2357 
 
2358 
<untidy2> : () -> () = @{
2359 
    g_unt = 1;
2360 
@} ;
2361 
 
2362 
<untidy3> : () -> () = @{
2363 
    g_unt = 3;
2364 
@} ;
2365 
 
2366 
<untidy4> : () -> () = @{
2367 
    g_unt = 2;
2368 
@} ;
2369 
 
2370 
<variety1> : ( condexp, thenpt, elsept, hold ) -> () = @{
2371 
    RESET_TDF(@hold);
2372 
    o_var_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
2373 
	       append_TDF(&@elsept,1));
2374 
@} ;
2375 
 
2376 
<variety2_dec> : () -> ( first, second, hold ) = @{
2377 
    /* @second uninitialised */
2378 
    SET_TDF(@hold, &@first);
2379 
@} ;
2380 
 
2381 
<variety3> : ( second, hold ) -> () = @{
2382 
    RESET_TDF(@hold);
2383 
    SET_TDF(@hold, &@second);
2384 
@} ;
2385 
 
2386 
<variety4> : ( first, second, hold ) -> () = @{
2387 
    RESET_TDF(@hold);
2388 
    o_var_limits(append_TDF(&@first,1), append_TDF(&@second,1));
2389 
@} ;
2390 
 
2391 
<varietychar> : () -> () = @{
2392 
    o_var_limits(
2393 
	o_make_signed_nat(out_tdfbool(issigned),
2394 
	    out_tdfint32(UL((issigned)?MINSC:0))),
2395 
	o_make_signed_nat(out_tdfbool(0),
2396 
	    out_tdfint32(UL((issigned)?MAXSC:MAXUSC))));
2397 
@} ;
2398 
 
2399 
<varietyint> : () -> () = @{
2400 
    o_var_limits(
2401 
	o_make_signed_nat(out_tdfbool(issigned),
2402 
	    out_tdfint32(UL((issigned)?MINSI:0))),
2403 
	o_make_signed_nat(out_tdfbool(0),
2404 
	    out_tdfint32(UL((issigned)?MAXSI:MAXUSI))));
2405 
@} ;
2406 
 
2407 
<varietylong> : () -> () = @{
2408 
    o_var_limits(
2409 
	o_make_signed_nat(out_tdfbool(issigned),
2410 
	    out_tdfint32(UL((issigned)?MINSL:0))),
2411 
	o_make_signed_nat(out_tdfbool(0),
2412 
	    out_tdfint32(UL((issigned)?MAXSL:MAXUSL))));
2413 
@} ;
2414 
 
2415 
<varietyopt1> : () -> () = @{
2416 
    /* unsigned char */
2417 
    o_var_limits(
2418 
	o_make_signed_nat(out_tdfbool(0), out_tdfint32(UL(0))),
2419 
	o_make_signed_nat(out_tdfbool(0), out_tdfint32(UL(255))));
2420 
@} ;
2421 
 
2422 
<varietyshort> : () -> () = @{
2423 
    o_var_limits(
2424 
	o_make_signed_nat(out_tdfbool(issigned),
2425 
	    out_tdfint32(UL((issigned)?MINSS:0))),
2426 
	o_make_signed_nat(out_tdfbool(0),
2427 
	    out_tdfint32(UL((issigned)?MAXSS:MAXUSS))));
2428 
@} ;
2429 
 
2430 
<vpar1> : () -> () = @{
2431 
    current_TDF->no=1;
2432 
@} ;
2433 
 
2434 
<vpar2> : () -> () = @{
2435 
    current_TDF->no=0;
2436 
@} ;
2437 
 
2438 
<syntax_error> : () -> () = @{
2439 
    fail("Syntax error");
2440 
@} ;
2441 
 
2442 
%trailer% @{
2443 
@}, @{
2444 
#endif
2445 
@} ;