Warning: Attempt to read property "date" on null in /usr/local/www/websvn.planix.org/blame.php on line 247

Warning: Attempt to read property "msg" on null in /usr/local/www/websvn.planix.org/blame.php on line 247
WebSVN – tendra.SVN – Blame – /branches/algol60/src/tools/tpl/syntax.act – Rev 7

Subversion Repositories tendra.SVN

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

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