Rev 2 | Blame | Compare with Previous | Last modification | View Log | RSS feed
%prefixes%
terminal = lex_ ;
%maps%
program -> read_program ;
access -> read_access ;
alignment -> read_alignment ;
al_tag -> read_al_tag ;
bitfield_variety -> read_bitfield_variety ;
bool -> read_bool ;
error_code -> read_error_code ;
error_code_list -> read_error_code_list ;
error_treatment -> read_error_treatment ;
exp -> read_exp ;
exp_list -> read_exp_list ;
floating_variety -> read_floating_variety ;
label -> read_label ;
nat -> read_nat ;
nat_option -> read_nat_option ;
ntest -> read_ntest ;
rounding_mode -> read_rounding_mode ;
shape -> read_shape ;
signed_nat -> read_signed_nat ;
string -> read_string ;
tag -> read_tag ;
token -> read_token ;
transfer_mode -> read_transfer_mode ;
variety -> read_variety ;
AL_TAGDEC -> PTR_Al_tagdec ;
INT -> int ;
LABDEC -> PTR_Labdec ;
NAME -> Name ;
SORT -> Sort ;
STRING -> PTR_char ;
PTR_TDF -> PTR_TDF ;
TAGDEC -> PTR_Tagdec ;
TDF -> TDF ;
TOKDEC -> PTR_Tokdec ;
TOKPAR -> PTR_Tokpar ;
ULONG -> unsigned_long ;
%header% @{
/*
Crown Copyright (c) 1997
This TenDRA(r) Computer Program is subject to Copyright
owned by the United Kingdom Secretary of State for Defence
acting through the Defence Evaluation and Research Agency
(DERA). It is made available to Recipients with a
royalty-free licence for its use, reproduction, transfer
to other parties and amendment for any purpose not excluding
product development provided that any such use et cetera
shall be deemed to be acceptance of the following conditions:-
(1) Its Recipients shall ensure that this Notice is
reproduced upon any copies or amended versions of it;
(2) Any amended version of it shall be clearly marked to
show both the nature of and the organisation responsible
for the relevant amendment or amendments;
(3) Its onward transfer from a recipient to another
party shall be deemed to be that party's acceptance of
these conditions;
(4) DERA gives no warranty or assurance as to its
quality or suitability for any purpose and DERA accepts
no liability whatsoever in relation to any use to which
it may be put.
*/
#include "config.h"
#include "util.h"
#include "defs.h"
#include "encodings.h"
#include "enc_nos.h"
#include "consfile.h"
#include "lex.h"
#include "analyse_sort.h"
#include "find_id.h"
#include "readstreams.h"
#include "standardsh.h"
#include "syntax.h"
#include "units.h"
#if FS_TENDRA
#pragma TenDRA begin
#pragma TenDRA unreachable code allow
#pragma TenDRA variable analysis off
#endif
static int saved = 0 ;
#define CURRENT_TERMINAL (unsigned)lex_v.t
#define ADVANCE_LEXER lex_v = reader ()
#define SAVE_LEXER(e) ((saved = lex_v.t), (lex_v.t = (e)))
#define RESTORE_LEXER (lex_v.t = saved)
typedef Al_tagdec *PTR_Al_tagdec ;
typedef Labdec *PTR_Labdec ;
typedef char *PTR_char ;
typedef Tagdec *PTR_Tagdec ;
typedef TDF *PTR_TDF ;
typedef Tokdec *PTR_Tokdec ;
typedef Tokpar *PTR_Tokpar ;
typedef unsigned long unsigned_long ;
static Tokpar * g_tokpars;
static Sort g_sname;
static TDF g_tok_defn;
static TokSort g_toksort;
int search_for_toks = 1;
static Tokdec * g_tokformals;
static int g_lastfield;
static TDF g_shape;
static TDF g_lastshape;
static Name * g_shtokname;
static int g_has_vis = 0;
static Bool issigned;
static Labdec * g_labdec;
static unsigned long intvalue;
static TDF optlab;
static TDF g_lower;
static TDF g_upper;
static Bool g_has_upper;
static TDF intro_acc;
static TDF intro_init;
static int query_t;
static int g_cr_v;
static int g_ce_v;
static int g_unt;
static Tagdec * g_app_tags;
static void do_procprops
PROTO_N ( (i) )
PROTO_T ( int i )
{
switch(i) {
case 0: return;
case 1: OPTION(o_var_callers); return;
case 2: OPTION(o_var_callees); return;
case 3: OPTION(o_add_procprops(o_var_callers, o_var_callees)); return;
case 4: OPTION(o_untidy); return;
case 5: OPTION(o_add_procprops(o_var_callers, o_untidy)); return;
case 6: OPTION(o_add_procprops(o_var_callees, o_untidy)); return;
case 7: OPTION(o_add_procprops(o_var_callers,
o_add_procprops(o_var_callees, o_untidy))); return;
case 8: OPTION(o_check_stack); return;
case 9: OPTION(o_add_procprops(o_var_callers,o_check_stack)); return;
case 10: OPTION(o_add_procprops(o_var_callees,o_check_stack)); return;
case 11: OPTION(o_add_procprops(o_check_stack,
o_add_procprops(o_var_callers, o_var_callees))); return;
case 12: OPTION(o_add_procprops(o_untidy,o_check_stack)); return;
case 13: OPTION(o_add_procprops(o_check_stack,
o_add_procprops(o_var_callers, o_untidy))); return;
case 14: OPTION(o_add_procprops(o_check_stack,
o_add_procprops(o_var_callees, o_untidy))); return;
case 15: OPTION(o_add_procprops(o_check_stack,
o_add_procprops(o_var_callers,
o_add_procprops(o_var_callees, o_untidy)))); return;
}
}
static int defaultlab = -1;
static TDF g_lablist;
int do_pp = 0;
static void success
PROTO_Z ()
{
IGNORE printf("Reached end\n");
print_res();
}
static int HAS_MAGIC = 1;
unsigned long MAJOR_NO = major_version;
unsigned long MINOR_NO = minor_version;
@}, @{
/*
Crown Copyright (c) 1997
This TenDRA(r) Computer Program is subject to Copyright
owned by the United Kingdom Secretary of State for Defence
acting through the Defence Evaluation and Research Agency
(DERA). It is made available to Recipients with a
royalty-free licence for its use, reproduction, transfer
to other parties and amendment for any purpose not excluding
product development provided that any such use et cetera
shall be deemed to be acceptance of the following conditions:-
(1) Its Recipients shall ensure that this Notice is
reproduced upon any copies or amended versions of it;
(2) Any amended version of it shall be clearly marked to
show both the nature of and the organisation responsible
for the relevant amendment or amendments;
(3) Its onward transfer from a recipient to another
party shall be deemed to be that party's acceptance of
these conditions;
(4) DERA gives no warranty or assurance as to its
quality or suitability for any purpose and DERA accepts
no liability whatsoever in relation to any use to which
it may be put.
*/
#ifndef SYNTAX_INCLUDED
#define SYNTAX_INCLUDED
extern int do_pp;
extern int search_for_toks;
extern unsigned long MAJOR_NO ;
extern unsigned long MINOR_NO ;
@} ;
%terminals%
%actions%
<acc_l1> : () -> () = @{
current_TDF->no=1;
@} ;
<acc_l2_dec> : () -> ( hold, x, prev ) = @{
@prev = current_TDF;
@hold = *current_TDF;
INIT_TDF(&@x);
RESET_TDF(&@x);
@} ;
<acc_l3> : ( hold, x, prev ) -> () = @{
INIT_TDF(@prev);
RESET_TDF(@prev);
o_add_accesses(append_TDF(&@hold,1), append_TDF(&@x, 1));
current_TDF->no = 1;
@} ;
<access1> : ( condexp, thenpt, elsept, hold ) -> () = @{
RESET_TDF(@hold);
o_access_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
append_TDF(&@elsept,1));
@} ;
<access2> : ( i ) -> () = @{
if (strcmp(constructs[@i].name, "visible")==0) { g_has_vis = 1; }
@} ;
<al_list1_dec> : () -> ( hold, place ) = @{
@place = current_TDF;
@hold = *current_TDF;
INIT_TDF(current_TDF);
@} ;
<al_list2> : ( hold, place ) -> () = @{
TDF second;
second = *current_TDF;
INIT_TDF(@place);
RESET_TDF(@place);
o_unite_alignments(append_TDF(&@hold,1), append_TDF(&second,1));
@} ;
<al_list_opt1> : () -> () = @{
o_alignment(o_top);
@} ;
<al_tag1> : () -> () = @{
char * n =lex_v.val.name;
Al_tagdec * x = find_al_tag(n);
if (x==(Al_tagdec*)0) {
x= MALLOC(Al_tagdec);
x->isdeffed =0; x->iskept=0;
NEW_IDNAME(x->idname, n, al_tag_ent);
x->next = al_tagdecs;
al_tagdecs = x;
}
x->isused =1;
make_al_tag(&x->idname.name);
@} ;
<al_tagdef2> : ( x, al, hold, already_used ) -> () = @{
RESET_TDF(@hold);
o_make_al_tagdef( if (@already_used) {
out_tdfint32(UL(non_local(&@x->idname.name,al_tag_ent)));
} else {
out_tdfint32(LOCNAME(@x->idname));
},
append_TDF(&@al, 1)
);
INC_LIST;
@} ;
<al_tgdf1_dec> : () -> ( x, al, hold, already_used ) = @{
char * n =lex_v.val.name;
@x = find_al_tag(n);
SELECT_UNIT(al_tagdef_unit);
if (@x==(Al_tagdec*)0) {
@x= MALLOC(Al_tagdec); @x->isdeffed =0; @x->iskept=0; @x->isused=0;
NEW_IDNAME(@x->idname, n, al_tag_ent);
@x->next = al_tagdecs; al_tagdecs = @x;
@already_used = 0;
}
else @already_used = 1;
if (@x->isdeffed) { fail("Al_tag %s defined twice", n); }
@x->isdeffed = 1;
SET_TDF(@hold, &@al);
@} ;
<alignment1> : ( condexp, thenpt, elsept, hold ) -> () = @{
RESET_TDF(@hold);
o_alignment_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
append_TDF(&@elsept,1));
@} ;
<alignment3> : ( at, hold ) -> () = @{
RESET_TDF(@hold);
o_obtain_al_tag(append_TDF(&@at, 1));
@} ;
<alment2_dec> : () -> ( at, hold ) = @{
SET_TDF(@hold, &@at);
@} ;
<bool1> : ( condexp, thenpt, elsept, hold ) -> () = @{
RESET_TDF(@hold);
o_bool_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
append_TDF(&@elsept,1));
@} ;
<bvar3_dec> : () -> ( sg, nt, hold ) = @{
/* @nt uninitialised */
SET_TDF(@hold, &@sg);
@} ;
<bvariety1> : ( condexp, thenpt, elsept, hold ) -> () = @{
RESET_TDF(@hold);
o_bfvar_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
append_TDF(&@elsept,1));
@} ;
<bvariety2> : () -> () = @{
if (issigned) { o_true; }
else { o_false; }
@} ;
<bvariety4> : ( sg, nt, hold ) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold, &@nt);
@} ;
<bvariety5> : ( sg, nt, hold ) -> () = @{
RESET_TDF(@hold);
o_bfvar_bits(append_TDF(&@sg,1), append_TDF(&@nt, 1));
@} ;
<call1_dec> : () -> ( fn, sh, ps, vp ) = @{
/* @sh, @ps, @vp uninitialised */
@fn = *current_TDF;
INIT_TDF(current_TDF);
@} ;
<call2> : ( sh ) -> () = @{
@sh = *current_TDF;
INIT_TDF(current_TDF);
@} ;
<call3> : ( ps ) -> () = @{
@ps = *current_TDF;
INIT_TDF(current_TDF);
@} ;
<call4> : ( fn, sh, ps, vp ) -> () = @{
@vp = *current_TDF;
INIT_TDF(current_TDF);
o_apply_proc(append_TDF(&@sh,1), append_TDF(&@fn,1),
{ append_TDF(&@ps, 1); current_TDF->no = @ps.no; },
if (@vp.no !=0) { OPTION(append_TDF(&@vp,1)); }
);
@} ;
<callee1_dec> : () -> ( el, hold ) = @{
SET_TDF(@hold, &@el);
@} ;
<callee2> : ( el, hold ) -> () = @{
RESET_TDF(@hold);
o_make_callee_list( { append_TDF(&@el,1); current_TDF->no = @el.no;} );
@} ;
<callee3_dec> : () -> ( pt, sz, hold ) = @{
/* @sz uninitialised */
SET_TDF(@hold, &@pt);
@} ;
<callee4> : ( pt, sz, hold ) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold, &@sz);
@} ;
<callee5> : ( pt, sz, hold ) -> () = @{
RESET_TDF(@hold);
o_make_dynamic_callees(append_TDF(&@pt,1), append_TDF(&@sz,1));
@} ;
<callee6> : () -> () = @{
o_same_callees;
@} ;
<cevaropt1> : () -> () = @{
g_ce_v = 0;
@} ;
<cevaropt2> : () -> () = @{
g_ce_v = 1;
@} ;
<chvar1_dec> : () -> ( v, ex, hold ) = @{
/* @ex uninitialised */
SET_TDF(@hold, &@v);
@} ;
<chvar2> : ( v, ex, hold ) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold, &@ex);
@} ;
<chvar3> : ( v, ex, hold ) -> () = @{
RESET_TDF(@hold);
o_change_variety(o_wrap, append_TDF(&@v,1), append_TDF(&@ex,1));
@} ;
<crvaropt1> : () -> () = @{
g_cr_v = 0;
@} ;
<crvaropt2> : () -> () = @{
g_cr_v = 1;
@} ;
<cseexp1_dec> : () -> ( cntrl, ll, hold ) = @{
/* @ll uninitialised */
SET_TDF(@hold, &@cntrl);
@} ;
<cseexp2> : ( cntrl, ll, hold ) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold, &@ll);
@} ;
<cseexp3> : ( cntrl, ll, hold ) -> () = @{
RESET_TDF(@hold);
o_case(o_false, append_TDF(&@cntrl,1),
{ append_TDF(&@ll,1); current_TDF->no = @ll.no; });
@} ;
<ctag_def3> : ( tfexp, sigopt, hold, x ) -> () = @{
RESET_TDF(@hold);
@x->iscommon = 1;
o_common_tagdef(out_tdfint32(UL(non_local(&@x->idname.name, tag_ent))), {},
if (@sigopt.no !=0) { OPTION(append_TDF(&@sigopt, 1)); },
append_TDF(&@tfexp, 1));
INC_LIST;
@x->isdeffed = 1;
@} ;
<ctag_def6> : ( tfexp, sigopt, hold, x, is_deced ) -> () = @{
RESET_TDF(@hold);
@x->iscommon = 1;
o_common_tagdef(out_tdfint32(UL(local_name(&@x->idname.name, tag_ent))), {},
if (@sigopt.no !=0) { OPTION(append_TDF(&@sigopt, @is_deced)); },
append_TDF(&@tfexp, 1));
INC_LIST;
SELECT_UNIT(tagdec_unit);
if (!@is_deced) {
o_common_tagdec(out_tdfint32(UL(non_local(&@x->idname.name,tag_ent))),
{},
if (@sigopt.no !=0) { OPTION(append_TDF(&@sigopt, 1)); },
o_shape_apply_token(make_tok(&@x->sh.shtok), {}));
INC_LIST;
}
@x->isdeffed=1; @x->hassh =1;
if (!@is_deced) { @x->next = tagdecs; tagdecs = @x; }
@} ;
<dest_o1_dec> : () -> ( hold ) = @{
SET_TDF(@hold, &optlab);
@} ;
<dest_opt2> : ( hold ) -> () = @{
RESET_TDF(@hold);
@} ;
<empty_snl> : () -> () = @{
g_tokpars = (Tokpar*)0;
@} ;
<eopt1> : () -> () = @{
o_make_signed_nat(out_tdfbool(0), out_tdfint32(UL(0)));
@} ;
<errc1> : () -> () = @{
current_TDF->no = 1;
@} ;
<errc2> : () -> () = @{
current_TDF->no ++;
@} ;
<errt1> : ( condexp, thenpt, elsept, hold ) -> () = @{
RESET_TDF(@hold);
o_errt_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
append_TDF(&@elsept,1));
@} ;
<errt2_dec> : () -> ( l, hold ) = @{
SET_TDF(@hold, &@l);
@} ;
<errt3> : ( l, hold ) -> () = @{
RESET_TDF(@hold);
o_error_jump(append_TDF(&@l,1));
@} ;
<errt5> : ( l, hold ) -> () = @{
RESET_TDF(@hold);
o_trap({append_TDF(&@l,1); current_TDF->no = @l.no; });
@} ;
<exp1> : ( condexp, thenpt, elsept, hold ) -> () = @{
RESET_TDF(@hold);
o_exp_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
append_TDF(&@elsept,1));
@} ;
<exp1_dec> : () -> ( first, second, place, n ) = @{
@n = lex_v.val.name;
@first = *current_TDF;
SET_TDF(@place, &@second);
@} ;
<exp2> : ( first, second, place, n ) -> () = @{
INIT_TDF(@place);
RESET_TDF(@place);
if(strcmp(@n, "*+.")==0) {
o_add_to_ptr(append_TDF(&@first,1), append_TDF(&@second,1));
} else if(strcmp(@n, "*-*")==0) {
o_subtract_ptrs(append_TDF(&@first,1), append_TDF(&@second,1));
} else if(strcmp(@n, ".*")==0) {
o_offset_mult(append_TDF(&@first,1), append_TDF(&@second,1));
} else if(strcmp(@n, ".+.")==0) {
o_offset_add(append_TDF(&@first,1), append_TDF(&@second,1));
} else if(strcmp(@n, ".-.")==0) {
o_offset_subtract(append_TDF(&@first,1), append_TDF(&@second,1));
} else if(strcmp(@n, "./")==0) {
o_offset_div_by_int(append_TDF(&@first,1), append_TDF(&@second,1));
} else if(strcmp(@n, "./.")==0) {
o_offset_div(
o_var_limits(
o_make_signed_nat(out_tdfbool(1), out_tdfint32(UL(MINSI))),
o_make_signed_nat(out_tdfbool(0), out_tdfint32(UL(MAXSI)))),
append_TDF(&@first,1), append_TDF(&@second,1));
} else if(strcmp(@n, ".max.")==0) {
o_offset_max(append_TDF(&@first,1), append_TDF(&@second,1));
} else { fail("%s not an addrop", @n); }
@} ;
<exp3> : ( first, second, place, n ) -> () = @{
INIT_TDF(@place);
RESET_TDF(@place);
if(strcmp(@n, "And")==0) {
o_and(append_TDF(&@first,1), append_TDF(&@second,1));
} else if(strcmp(@n, "Or")==0) {
o_or(append_TDF(&@first,1), append_TDF(&@second,1));
} else if(strcmp(@n, "Xor")==0) {
o_xor(append_TDF(&@first,1), append_TDF(&@second,1));
} else { fail("%s not a logop", @n); }
@} ;
<exp5> : ( first, second, place, n ) -> () = @{
INIT_TDF(@place);
RESET_TDF(@place);
if (strcmp(@n,"%")==0) {
o_rem2(o_continue, o_continue, append_TDF(&@first,1),
append_TDF(&@second,1));
} else if (strcmp(@n,"%1")==0) {
o_rem1(o_continue, o_continue, append_TDF(&@first,1),
append_TDF(&@second,1));
} else if (strcmp(@n,"*")==0) {
o_mult(o_wrap, append_TDF(&@first,1), append_TDF(&@second,1));
} else if (strcmp(@n,"+")==0) {
o_plus(o_wrap, append_TDF(&@first,1), append_TDF(&@second,1));
} else if (strcmp(@n,"-")==0) {
o_minus(o_wrap, append_TDF(&@first,1), append_TDF(&@second,1));
} else if (strcmp(@n,"/")==0) {
o_div2(o_continue, o_continue, append_TDF(&@first,1),
append_TDF(&@second,1));
} else if (strcmp(@n,"/1")==0) {
o_div1(o_continue, o_continue, append_TDF(&@first,1),
append_TDF(&@second,1));
} else if (strcmp(@n,"<<")==0) {
o_shift_left(o_wrap, append_TDF(&@first,1), append_TDF(&@second,1));
} else if (strcmp(@n,"F*")==0) {
o_floating_mult(o_continue,
{ LIST_ELEM(append_TDF(&@first,1));
LIST_ELEM(append_TDF(&@second,1)) });
} else if (strcmp(@n,">>")==0) {
o_shift_right(append_TDF(&@first,1), append_TDF(&@second,1));
} else if (strcmp(@n,"F+")==0) {
o_floating_plus(o_continue,
{ LIST_ELEM(append_TDF(&@first,1));
LIST_ELEM(append_TDF(&@second,1)) });
} else if (strcmp(@n,"F-")==0) {
o_floating_minus(o_continue, append_TDF(&@first,1),
append_TDF(&@second,1));
} else if (strcmp(@n,"F/")==0) {
o_floating_div(o_continue, append_TDF(&@first,1),
append_TDF(&@second,1));
} else { fail("%s not an arithop", @n); }
@} ;
<exp6> : ( first, second, place, n ) -> () = @{
INIT_TDF(@place);
RESET_TDF(@place);
o_assign(append_TDF(&@first,1), append_TDF(&@second,1));
@} ;
<exp_sls1> : () -> () = @{
current_TDF->no =1;
o_make_top;
@} ;
<exp_sls2> : () -> () = @{
current_TDF->no =1;
@} ;
<exp_sls3_dec> : () -> ( nextexp, place ) = @{
SET_TDF(@place, &@nextexp);
@} ;
<exp_sls4> : ( nextexp, place ) -> () = @{
RESET_TDF(@place);
if (lex_v.t == lex_semi) {
current_TDF->no +=1;
append_TDF(&@nextexp,1);
} else {
TDF stats;
stats = *current_TDF;
INIT_TDF(current_TDF);
o_sequence(
{ append_TDF(&stats,1); current_TDF->no = stats.no; },
append_TDF(&@nextexp,1));
/* cheats LIST in o_sequence */
}
@} ;
<exp_sls5> : () -> () = @{
o_make_top;
@} ;
<expcond1_dec> : () -> ( thpart, elsepart, condlab, hold, old_lab, old_labdecs ) = @{
/* @elsepart, @condlab uninitialised */
@old_lab = defaultlab;
@old_labdecs = labdecs;
defaultlab = -1;
SET_TDF(@hold, &@thpart);
@} ;
<expcond2> : ( elsepart, hold ) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold, &@elsepart);
@} ;
<expcond3> : ( condlab, old_lab, old_labdecs ) -> () = @{
@condlab = optlab;
defaultlab = @old_lab;
tidy_labels(@old_labdecs);
@} ;
<expcond4> : ( thpart, elsepart, condlab, hold ) -> () = @{
INIT_TDF(@hold);
RESET_TDF(@hold);
o_conditional(append_TDF(&@condlab,1),
append_TDF(&@thpart,1), append_TDF(&@elsepart,1));
@} ;
<expcons1_dec> : () -> ( sz, elist, hold ) = @{
/* @elist uninitialised */
SET_TDF(@hold, &@sz);
@} ;
<expcons2> : ( sz, elist, hold ) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold, &@elist);
@} ;
<expcons3> : ( sz, elist, hold ) -> () = @{
RESET_TDF(@hold);
o_make_compound(append_TDF(&@sz,1),
{ append_TDF(&@elist,1); current_TDF->no = @elist.no; });
@} ;
<expdec1_dec> : () -> ( ldecs ) = @{
@ldecs = localdecs;
@} ;
<expdec2> : ( ldecs ) -> () = @{
localdecs = @ldecs;
@} ;
<expfail1> : () -> () = @{
o_fail_installer(read_string());
@} ;
<exphold1_dec> : () -> ( new, hold, empty, lineno, char_pos ) = @{
@empty = (current_TDF->first == current_TDF->last &&
current_TDF->first->usage == 0 &&
current_TDF->first->offst == 0);
@lineno = cLINE;
@char_pos = bind;
if (!@empty || line_no_tok != -1) { SET_TDF(@hold, &@new); }
@} ;
<exphold2> : ( new, hold, empty, lineno, char_pos ) -> () = @{
if (!@empty || line_no_tok != -1) {
SET(@hold);
RESET_TDF(@hold);
if (line_no_tok != -1) {
o_exp_apply_token(
o_make_tok(out_tdfint32(UL(cname_to_lname(line_no_tok,tok_ent)))),
{ append_TDF(&@new,1);
o_make_sourcemark(FILENAME(),
o_make_nat(out_tdfint32(@lineno)),
o_make_nat(out_tdfint32(UL(@char_pos))));
o_make_sourcemark(FILENAME(),
o_make_nat(out_tdfint32(cLINE)),
o_make_nat(out_tdfint32(UL(bind))));
});
} else append_TDF(&@new,1);
}
@} ;
<expl1> : () -> () = @{
current_TDF->no=0;
@} ;
<expl2> : () -> () = @{
current_TDF->no++;
@} ;
<explab1_dec> : () -> ( starter, elist, old_lablist, hold, old_labdecs ) = @{
/* @elist uninitialised */
@old_labdecs = labdecs;
@old_lablist = g_lablist;
INIT_TDF(&g_lablist);
SET_TDF(@hold, &@starter);
@} ;
<explab2> : ( elist, hold ) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold, &@elist);
@} ;
<explab3> : ( starter, elist, old_lablist, hold, old_labdecs ) -> () = @{
RESET_TDF(@hold);
o_labelled( { append_TDF(&g_lablist,1);
current_TDF->no = g_lablist.no;},
append_TDF(&@starter, 1),
{ append_TDF(&@elist,1);
current_TDF->no = g_lablist.no;});
tidy_labels(@old_labdecs);
g_lablist = @old_lablist;
@} ;
<expneg1_dec> : () -> ( e, hold ) = @{
SET_TDF(@hold, &@e);
@} ;
<expnegate2> : ( e, hold ) -> () = @{
RESET_TDF(@hold);
o_negate(o_wrap, append_TDF(&@e,1));
@} ;
<expproc1_dec> : () -> ( pars, vpar, body, sh, hold, old_locals, old_labels ) = @{
/* @pars, @vpar, @body uninitialised */
@old_locals = localdecs;
@old_labels = labdecs;
localdecs = (Tagdec*)0;
labdecs = (Labdec *)0;
SET_TDF(@hold, &@sh);
@} ;
<expproc2> : ( pars, hold ) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold, &@pars)
@} ;
<expproc3> : ( vpar, hold ) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold, &@vpar);
@} ;
<expproc4> : ( body, hold ) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold, &@body);
@} ;
<expproc5> : ( pars, vpar, body, sh, hold, old_locals, old_labels ) -> () = @{
RESET_TDF(@hold);
o_make_proc(append_TDF(&@sh,1),
{ append_TDF(&@pars,1); current_TDF->no = @pars.no;},
if (@vpar.no !=0) {OPTION(append_TDF(&@vpar,1)); },
append_TDF(&@body,1);)
while (labdecs != (Labdec *)0 ) {
if (!labdecs->declared) {
fail("Label %s not declared", labdecs->idname.id);
}
labdecs = labdecs->next;
}
localdecs = @old_locals;
labdecs = @old_labels;
@} ;
<exprep1_dec> : () -> ( st, bdy, condlab, hold, old_labdecs, old_lab ) = @{
/* @bdy, @condlab, @old_lab uninitialised */
@old_labdecs = labdecs;
SET_TDF(@hold, &@st);
@} ;
<exprep2> : ( old_lab ) -> () = @{
@old_lab = defaultlab;
defaultlab = -1;
@} ;
<exprep3> : ( bdy, condlab, hold ) -> () = @{
@condlab = optlab;
RESET_TDF(@hold);
SET_TDF(@hold, &@bdy);
@} ;
<exprep4> : ( st, bdy, condlab, hold, old_labdecs, old_lab ) -> () = @{
RESET_TDF(@hold);
o_repeat(append_TDF(&@condlab,1), append_TDF(&@st,1), append_TDF(&@bdy,1));
tidy_labels(@old_labdecs);
defaultlab = @old_lab;
@} ;
<expstar1> : () -> () = @{
char * n = lex_v.val.name;
Tagdec * x = find_tag(n);
if (x == (Tagdec*)0) { fail("%s is not a tag", n); }
else
if (!x->isvar || x->hassh == 0) {
fail("Don't know shape of %s", n);
}
o_contents(
if (x->hassh == 1) {
o_shape_apply_token(make_tok(&x->sh.shtok), {});
} else { append_TDF(&x->sh.tdfsh, 0); },
o_obtain_tag(make_tag(&x->idname.name)));
@} ;
<expstar2_dec> : () -> ( sh, e, hold ) = @{
/* @e uninitialised */
SET_TDF(@hold, &@sh);
@} ;
<expstar3> : ( e, hold ) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold, &@e);
@} ;
<expstar4> : ( sh, e, hold ) -> () = @{
RESET_TDF(@hold);
o_contents(append_TDF(&@sh,1), append_TDF(&@e,1));
@} ;
<expstr1_dec> : () -> ( st, vart, hold ) = @{
/* @vart uninitialised */
SET_TDF(@hold, &@st);
@} ;
<expstr2> : ( vart, hold ) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold, &@vart);
@} ;
<expstring2> : ( st, vart, hold ) -> () = @{
RESET_TDF(@hold);
o_make_nof_int(append_TDF(&@vart, 1), append_TDF(&@st, 1););
@} ;
<exptag1> : () -> () = @{
TDF tg;
tg = *current_TDF;
INIT_TDF(current_TDF);
o_obtain_tag(append_TDF(&tg,1));
@} ;
<exptst1_dec> : () -> ( first, nt, second, hold, qt ) = @{
/* @nt, @second uninitialised */
@qt = query_t;
SET_TDF(@hold,&@first);
@} ;
<exptst2> : ( nt, hold ) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold,&@nt);
@} ;
<exptst3> : ( second, hold ) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold, &@second)
@} ;
<exptst4> : ( first, nt, second, hold, qt ) -> () = @{
RESET_TDF(@hold);
switch(@qt) {
case lex_query:
o_integer_test({}, append_TDF(&@nt,1), append_TDF(&optlab,1),
append_TDF(&@first, 1), append_TDF(&@second,1));
break;
case lex_float__query:
o_floating_test({}, o_impossible, append_TDF(&@nt,1),
append_TDF(&optlab,1),
append_TDF(&@first, 1), append_TDF(&@second,1));
break;
case lex_ptr__query:
o_pointer_test( {}, append_TDF(&@nt,1),append_TDF(&optlab,1),
append_TDF(&@first, 1), append_TDF(&@second,1));
break;
case lex_proc__query:
o_proc_test( {}, append_TDF(&@nt,1),append_TDF(&optlab,1),
append_TDF(&@first, 1), append_TDF(&@second,1)
);
break;
case lex_offset__query:
o_offset_test({}, append_TDF(&@nt,1), append_TDF(&optlab,1),
append_TDF(&@first, 1), append_TDF(&@second,1)
);
break;
default: fail("Don't understand test");
}
@} ;
<fden1_dec> : () -> ( mant, e, v, rm, hold, neg, r ) = @{
/* @v, @rm uninitialised */
@neg = 0;
@r = UL(radix);
SET_TDF(@hold, &@mant);
out_tdfstring_bytes(fformat(lex_v.val.name,lnum), 8, UI(lnum));
RESET_TDF(@hold);
SET_TDF(@hold, &@e);
@} ;
<fden2_dec> : () -> ( mant, e, v, rm, hold, neg, r ) = @{
/* @v, @rm uninitialised */
@neg = 1;
@r = UL(radix);
SET_TDF(@hold, &@mant);
out_tdfstring_bytes(fformat(lex_v.val.name,lnum), 8, UI(lnum));
RESET_TDF(@hold);
SET_TDF(@hold, &@e);
@} ;
<fden3> : ( v, hold ) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold, &@v);
@} ;
<fden4> : ( rm, hold ) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold, &@rm);
@} ;
<fden5> : ( mant, e, v, rm, hold, neg, r ) -> () = @{
RESET_TDF(@hold);
o_make_floating(append_TDF(&@v,1),
append_TDF(&@rm,1),
if (@neg) { o_true; } else { o_false; },
o_make_string(append_TDF(&@mant, 1)),
o_make_nat(out_tdfint32(@r)),
append_TDF(&@e, 1));
@} ;
<field1_dec> : () -> ( hold, x, y ) = @{
char * dotn = append_string(".",lex_v.val.name);
char * n = lex_v.val.name;
@x = find_tok(dotn);
@y = find_tok(n);
if (@x!=(Tokdec*)0 || @y!=(Tokdec*)0)
fail("Field name %s must be unique", dotn);
@x = MALLOC(Tokdec); NEW_IDNAME(@x->idname, dotn, tok_ent);
@x->isdeffed = 1; @x->isused=0; @x->iskept = 0;
@x->sort.ressort.sort = exp_sort;
@x->sort.pars = (Tokpar *)0;
@y = MALLOC(Tokdec); NEW_IDNAME(@y->idname, n, tok_ent);
@y->isdeffed = 1; @y->isused=0; @y->iskept = 0;
@y->sort.ressort.sort = exp_sort;
@y->sort.pars = MALLOC(Tokpar);
@y->sort.pars->par.sort = exp_sort;
@y->sort.pars->next = (Tokpar*)0;
@x->next = @y;
SET_TDF(@hold, &g_shape);
@} ;
<field2> : ( hold, x, y ) -> () = @{
int tn;
RESET_TDF(@hold);
o_make_tokdef(out_tdfint32(LOCNAME(@x->idname)), {},
o_token_def(o_exp, {},
if (g_lastfield==-1) { /* first field */
o_offset_zero(o_alignment(append_TDF(&g_shape, 0)));
} else {
o_offset_pad(o_alignment(append_TDF(&g_shape,0)),
o_offset_add(o_exp_apply_token(
o_make_tok(out_tdfint32(UL(g_lastfield))),{}),
o_shape_offset(append_TDF(&g_lastshape, 1))))
}));
g_lastfield = (int)(LOCNAME(@x->idname));
g_lastshape = g_shape;
INC_LIST;
o_make_tokdef(out_tdfint32(LOCNAME(@y->idname)), {},
o_token_def(o_exp,
LIST_ELEM(o_make_tokformals(o_exp,
out_tdfint32(UL(tn=next_unit_name(tok_ent))))),
o_component(append_TDF(&g_lastshape,0),
o_exp_apply_token(o_make_tok(out_tdfint32(UL(tn))),{}),
o_exp_apply_token(
o_make_tok(out_tdfint32(UL(g_lastfield))),{}))));
INC_LIST;
@y->next = tokdecs;
tokdecs = @x;
@} ;
<fvar1> : ( condexp, thenpt, elsept, hold ) -> () = @{
RESET_TDF(@hold);
o_flvar_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
append_TDF(&@elsept,1));
@} ;
<fvardouble> : () -> () = @{
o_flvar_parms(o_make_nat(out_tdfint32(UL(2))),
o_make_nat(out_tdfint32(UL(MANT_DOUBLE))),
o_make_nat(out_tdfint32(UL(MINEXP_DOUBLE))),
o_make_nat(out_tdfint32(UL(MAXEXP_DOUBLE))));
@} ;
<fvarfloat> : () -> () = @{
o_flvar_parms(o_make_nat(out_tdfint32(UL(2))),
o_make_nat(out_tdfint32(UL(MANT_FLOAT))),
o_make_nat(out_tdfint32(UL(MINEXP_FLOAT))),
o_make_nat(out_tdfint32(UL(MAXEXP_FLOAT))));
@} ;
<gcall1_dec> : () -> ( cers, cees, plude, cr_v, ce_v, old_app_tags, app_tags, old_tagdecs ) = @{
/* @cers, @cees, @plude uninitialised */
/* @cr_v, @ce_v, @app_tags uninitialised */
@old_app_tags = g_app_tags;
@old_tagdecs = tagdecs;
g_app_tags = (Tagdec*)0;
@} ;
<gcall2> : ( cers, cr_v, old_app_tags, app_tags ) -> () = @{
@cers = *current_TDF;
INIT_TDF(current_TDF);
@cr_v = g_cr_v;
@app_tags = g_app_tags;
g_app_tags = @old_app_tags;
@} ;
<gcall3> : ( cees, ce_v, app_tags ) -> () = @{
@cees = *current_TDF;
@ce_v = g_ce_v;
INIT_TDF(current_TDF);
while (@app_tags != (Tagdec*)0) {
Tagdec * x = @app_tags;
@app_tags = x->next;
x->next = tagdecs;
tagdecs = x;
}
@} ;
<gcall4> : ( fn, sh, cers, cees, plude, cr_v, ce_v, old_tagdecs ) -> () = @{
@plude = *current_TDF;
INIT_TDF(current_TDF);
tagdecs = @old_tagdecs;
o_apply_general_proc(
append_TDF(&@sh,1), do_procprops(@cr_v+2*@ce_v+4*g_unt),
append_TDF(&@fn,1),
{ append_TDF(&@cers,1); current_TDF->no = @cers.no; },
append_TDF(&@cees,1),
append_TDF(&@plude, 1))
@} ;
<gencond1_dec> : () -> ( condexp, thenpt, elsept, hold ) = @{
/* @thenpt, @elsept uninitialised */
SET_TDF(@hold, &@condexp);
@} ;
<gencond2> : ( thenpt, hold ) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold, &@thenpt);
@} ;
<gencond3> : ( elsept, hold ) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold, &@elsept);
@} ;
<gencons1_dec> : () -> ( i ) = @{
@i = lex_v.val.v;
@} ;
<gencons2> : ( i ) -> () = @{
(constructs[@i].f)();
@} ;
<genhold1_dec> : () -> ( new, hold, empty ) = @{
@empty = (current_TDF->first == current_TDF->last &&
current_TDF->first->usage == 0 &&
current_TDF->first->offst == 0);
if (!@empty) { SET_TDF(@hold, &@new); }
@} ;
<genhold2> : ( new, hold, empty ) -> () = @{
if (!@empty ) {
SET(@hold);
RESET_TDF(@hold);
append_TDF(&@new,1);
}
@} ;
<gentok1_dec> : () -> ( td ) = @{
@td = lex_v.val.tokname;
@td->isused = 1;
@} ;
<gentok2> : ( td ) -> () = @{
expand_tok(@td, &@td->sort);
@} ;
<gproc1_dec> : () -> ( sh, cers, cees, body, hold, cr_v, ce_v, c_unt, old_locals, old_labels ) = @{
/* @cers, @cees, @body uninitialised */
/* @cr_v, @ce_v @c_unt uninitialised */
@old_locals = localdecs;
@old_labels = labdecs;
localdecs = (Tagdec*)0;
labdecs = (Labdec *)0;
SET_TDF(@hold, &@sh);
@} ;
<gproc2> : ( cers, hold ) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold, &@cers);
@} ;
<gproc3> : ( cees, hold, cr_v) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold, &@cees);
@cr_v = g_cr_v;
@} ;
<gproc4> : ( body, hold, ce_v ) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold, &@body);
@ce_v = g_ce_v;
@} ;
<gproc5> : ( c_unt ) -> () = @{
@c_unt = g_unt;
@} ;
<gproc6> : ( sh, cers, cees, body, hold, cr_v, ce_v, c_unt, old_locals, old_labels ) -> () = @{
RESET_TDF(@hold);
o_make_general_proc(append_TDF(&@sh,1),
do_procprops(@cr_v+2*@ce_v+4*@c_unt),
{ append_TDF(&@cers,1);
current_TDF->no = @cers.no;},
{ append_TDF(&@cees,1);
current_TDF->no = @cees.no;},
append_TDF(&@body,1))
while (labdecs != (Labdec *)0 ) {
if (!labdecs->declared) {
fail("Label %s not declared", labdecs->idname.id);
}
labdecs = labdecs->next;
}
localdecs = @old_locals;
labdecs = @old_labels;
@} ;
<ibody1_dec> : () -> ( acc, init, body, hold, tg, isvar ) = @{
@isvar = localdecs->isvar;
@acc = intro_acc;
@init = intro_init;
@tg = localdecs->idname.name;
SET_TDF(@hold, &@body);
@} ;
<integer1> : () -> () = @{
intvalue = UL(stoi(lex_v.val.name, lnum));
@} ;
<integer2> : () -> () = @{
intvalue = UL(lex_v.val.v);
@} ;
<intro1_dec> : () -> ( acc, init, hold, x, has_vis ) = @{
/* @init, @has_vis uninitialised */
char* n = lex_v.val.name;
@x = find_tag(n);
if (@x != (Tagdec*)0) { fail("Tag %s declared twice", n); }
@x = MALLOC(Tagdec); @x->isdeffed = 1; @x->hassh=0; @x->iskept=0;
NEW_IDNAME(@x->idname, n, tag_ent);
g_has_vis = 0;
SET_TDF(@hold, &@acc);
@} ;
<intro2> : ( init, hold, has_vis ) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold, &@init);
@has_vis = g_has_vis;
@} ;
<intro3> : ( hold, x ) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold, &@x->sh.tdfsh);
@x->hassh=2;
@} ;
<intro4> : ( acc, init, hold, x, has_vis ) -> () = @{
RESET_TDF(@hold);
intro_acc = @acc;
intro_init = @init;
@x->isvar=1;
if (@has_vis) {
Tagdec * y = MALLOC(Tagdec);
*y = *@x;
y->next = tagdecs;
tagdecs = y;
}
@x->next = localdecs;
localdecs = @x;
@} ;
<intro5> : ( acc, init, hold, x, has_vis ) -> () = @{
RESET_TDF(@hold);
intro_acc = @acc;
intro_init = @init;
@x->isvar=0;
if (@has_vis) {
Tagdec * y = MALLOC(Tagdec);
*y = *@x;
y->next = tagdecs;
tagdecs = y;
}
@x->next = localdecs;
localdecs = @x;
@} ;
<intro6> : ( x ) -> () = @{
o_make_value(append_TDF(&@x->sh.tdfsh, 0));
@} ;
<introbody2> : ( acc, init, body, hold, tg, isvar ) -> () = @{
RESET_TDF(@hold);
if (@isvar) {
o_variable( if(@acc.no!=0) { OPTION(append_TDF(&@acc,1)); },
make_tag(&@tg), append_TDF(&@init,1),
append_TDF(&@body,1));
} else {
o_identify( if(@acc.no!=0) { OPTION(append_TDF(&@acc,1)); },
make_tag(&@tg), append_TDF(&@init,1),
append_TDF(&@body,1));
}
@} ;
<keep1> : () -> () = @{
Tokdec * k = lex_v.val.tokname;
k->iskept = 1;
@} ;
<keep2> : () -> () = @{
char * n = lex_v.val.name;
Tagdec * t = find_tag(n);
if (t != (Tagdec*)0){
t->iskept = 1;
} else {
Al_tagdec * a = find_al_tag(n);
if (a == (Al_tagdec*)0) {
fail("Ident %s not declared",n);
}
a->iskept = 1;
}
@} ;
<keeps1> : () -> () = @{
int i;
for(i=0; i<NO_OF_ENTITIES; i++) {
INIT_TDF(lk_externs+i);
}
@} ;
<keeps2> : () -> () = @{
CONT_STREAM(&units[tld2_unit].tdf, out_tdfint32(UL(1)));
if(line_no_tok != -1) {
current_TDF = lk_externs+tok_ent;
o_make_linkextern(
out_tdfint32(UL(line_no_tok)),
o_string_extern(
{ out_tdfident_bytes("~exp_to_source"); }));
current_TDF->no++;
CONT_STREAM(&units[tld2_unit].tdf, out_tdfint32(UL(3)));
}
{
Tokdec * k = tokdecs;
while (k != (Tokdec*)0) {
if (!k->isdeffed || k->iskept) {
int capname = capsule_name(&k->idname.name, tok_ent);
char * n = k->idname.id;
current_TDF = lk_externs+tok_ent;
o_make_linkextern(out_tdfint32(UL(capname)),
o_string_extern({ out_tdfident_bytes(n); }));
current_TDF->no++;
CONT_STREAM(&units[tld2_unit].tdf,
{ int i = k->isused + 2 + 4*k->isdeffed;
out_tdfint32(UL(i)); });
}
k = k->next;
}
}
{
Tagdec * k = tagdecs;
while (k != (Tagdec*)0) {
if (!k->isdeffed || k->iskept) {
int capname = capsule_name(&k->idname.name, tag_ent);
char * n = k->idname.id;
current_TDF = lk_externs+tag_ent;
o_make_linkextern(out_tdfint32(UL(capname)),
o_string_extern({ out_tdfident_bytes(n); }));
current_TDF->no++;
CONT_STREAM(&units[tld2_unit].tdf,
{ int i = k->isused + 2 + ((k->iscommon)?8:(4*k->isdeffed));
out_tdfint32(UL(i)); });
}
k = k->next;
}
}
{
Al_tagdec * k = al_tagdecs;
while (k != (Al_tagdec*)0) {
if (!k->isdeffed || k->iskept) {
int capname = capsule_name(&k->idname.name, al_tag_ent);
char * n = k->idname.id;
current_TDF = lk_externs+al_tag_ent;
o_make_linkextern(out_tdfint32(UL(capname)),
o_string_extern({ out_tdfident_bytes(n); }));
current_TDF->no++;
CONT_STREAM(&units[tld2_unit].tdf,
{ int i = k->isused + 2 + 4*k->isdeffed;
out_tdfint32(UL(i)); });
}
k = k->next;
}
}
{
int i;
TDF caps;
add_extra_toks();
INIT_TDF(&caps);
RESET_TDF(&caps);
if (do_pp) success();
if (HAS_MAGIC) {
out_basic_int(UL('T'), UI(8));
out_basic_int(UL('D'), UI(8));
out_basic_int(UL('F'), UI(8));
out_basic_int(UL('C'), UI(8));
out_tdfint32(MAJOR_NO);
out_tdfint32(MINOR_NO);
byte_align();
}
o_make_capsule(
{
for(i=0; i<NO_OF_UNITS; i++) {
if(units[i].present) {
char* n;
n = unit_names[i];
LIST_ELEM({ out_tdfident_bytes(n); });
}
}
},
{
for(i=0; i<NO_OF_ENTITIES; i++) {
char* n;
n = ent_names[i];
LIST_ELEM(
o_make_capsule_link(
{ out_tdfident_bytes(n);},
out_tdfint32(UL(capsule_names[i]))))
}
},
{
for(i=0; i<NO_OF_ENTITIES; i++) {
TDF * lks = lk_externs+i;
LIST_ELEM(
o_make_extern_link(
{ append_TDF(lks,1); current_TDF->no = lks->no; });
)
}
},
{
for(i=0; i<NO_OF_UNITS; i++) {
if(units[i].present) {
LIST_ELEM(
o_make_group(LIST_ELEM(make_unit(i))););
}
}
}
);
make_tdf_file(&caps, out_file);
}
@} ;
<label1> : () -> () = @{
char * n =lex_v.val.name;
Labdec * x = find_lab(n);
if (x==(Labdec*)0) {
x = MALLOC(Labdec);
x->idname.id = n; x->idname.name.unit_name = next_label();
x->declared = 0;
x->next = labdecs; labdecs = x;
}
g_labdec = x;
o_make_label(out_tdfint32(LOCNAME(x->idname)));
@} ;
<llist1_dec> : () -> ( thisexp, hold ) = @{
@hold = current_TDF;
INIT_TDF(&@thisexp);
current_TDF = &g_lablist;
@} ;
<llist2> : ( thisexp ) -> () = @{
if (g_labdec != (Labdec*)0) {
if (g_labdec->declared) {
fail("Label %s set twice", g_labdec->idname.id);
}
g_labdec->declared = 1;
}
current_TDF = &@thisexp;
@} ;
<llist3> : () -> () = @{
g_lablist.no = 1;
@} ;
<llist4> : () -> () = @{
g_lablist.no++;
@} ;
<llist5> : ( thisexp, hold ) -> () = @{
RESET_TDF(@hold);
append_TDF(&@thisexp, 1);
@} ;
<lset_o1> : () -> () = @{
TDF * hold;
SET_TDF(hold, &optlab);
if (defaultlab==-1) defaultlab = next_label();
o_make_label(out_tdfint32(UL(defaultlab)));
RESET_TDF(hold);
@} ;
<lset_o2_dec> : () -> ( hold ) = @{
SET_TDF(@hold, &optlab);
g_labdec = (Labdec*)0;
if (defaultlab != -1) { fail("This conditional uses a default jump"); }
@} ;
<lset_o3> : ( hold ) -> () = @{
if (g_labdec != (Labdec*)0) {
if (g_labdec->declared) {
fail("Label %s set twice", g_labdec->idname.id);
}
g_labdec->declared = 1;
}
RESET_TDF(@hold);
@} ;
<mint1_dec> : () -> ( nt, v ) = @{
/* @v uninitialised */
@nt = *current_TDF;
INIT_TDF(current_TDF);
@} ;
<mint2> : ( nt, v ) -> () = @{
@v = *current_TDF;
INIT_TDF(current_TDF);
o_make_int(append_TDF(&@v,1), append_TDF(&@nt,1));
@} ;
<nat1> : ( condexp, thenpt, elsept, hold ) -> () = @{
RESET_TDF(@hold);
o_nat_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
append_TDF(&@elsept,1));
@} ;
<nat2> : () -> () = @{
o_make_nat(out_tdfint32(intvalue));
@} ;
<natopt1> : ( new, hold ) -> () = @{
RESET_TDF(@hold);
OPTION(append_TDF(&@new,1));
@} ;
<natopt_dec> : () -> ( new, hold ) = @{
SET_TDF(@hold, &@new);
@} ;
<newstr_opt1> : () -> () = @{
current_TDF->no=1;
@} ;
<newstring1> : () -> () = @{
char * s = lex_v.val.name;
o_make_string(out_tdfstring_bytes(s, 8, UI(strlen(s))));
@} ;
<newstring2> : ( condexp, thenpt, elsept, hold ) -> () = @{
RESET_TDF(@hold);
o_string_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
append_TDF(&@elsept,1));
@} ;
<ntest1> : ( condexp, thenpt, elsept, hold ) -> () = @{
RESET_TDF(@hold);
o_ntest_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
append_TDF(&@elsept,1));
@} ;
<ntest2> : () -> () = @{
char * n = lex_v.val.name;
if (strcmp(n,"!<")==0) { o_not_less_than; }
else if (strcmp(n,"!<=")==0) { o_not_less_than_or_equal; }
else if (strcmp(n,"!=")==0) { o_not_equal; }
else if (strcmp(n,"!>")==0) { o_not_greater_than; }
else if (strcmp(n,"!>=")==0) { o_not_greater_than_or_equal; }
else if (strcmp(n,"!Comparable")==0) { o_not_comparable; }
else if (strcmp(n,"<")==0) { o_less_than; }
else if (strcmp(n,"<=")==0) { o_less_than_or_equal; }
else if (strcmp(n,"==")==0) { o_equal; }
else if (strcmp(n,">")==0) { o_greater_than; }
else if (strcmp(n,">=")==0) { o_greater_than_or_equal; }
else if (strcmp(n,"Comparable")==0) { o_comparable; }
else { fail("%s is not a comparison", n); }
@} ;
<offexpl1> : () -> () = @{
current_TDF->no = 2;
@} ;
<offexpl2> : () -> () = @{
current_TDF->no+=2;
@} ;
<otagel1> : () -> () = @{
current_TDF->no = 1;
@} ;
<otagel2> : () -> () = @{
current_TDF->no++;
@} ;
<otagel_opt1> : () -> () = @{
current_TDF->no = 0;
@} ;
<otagexp1_dec> : () -> ( e, hold ) = @{
SET_TDF(@hold, &@e);
@} ;
<otagexp2> : ( e, hold ) -> () = @{
RESET_TDF(@hold);
o_make_otagexp( {}, append_TDF(&@e,1));
@} ;
<otagexp3> : ( e, hold ) -> () = @{
char* n = lex_v.val.name;
Tagdec * x = find_tag(n);
if (x != (Tagdec*)0) { fail("Tag %s declared twice", n); }
x = MALLOC(Tagdec); x->isdeffed = 1; x->hassh=0; x->iskept=0;
NEW_IDNAME(x->idname, n, tag_ent);
x->isvar = 1;
x->next = g_app_tags; g_app_tags = x;
RESET_TDF(@hold);
o_make_otagexp( OPTION(make_tag(&x->idname.name)),append_TDF(&@e,1));
@} ;
<plude1> : () -> () = @{
o_make_top;
@} ;
<proc_def1> : ( tfexp, hold ) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold, &@tfexp);
@} ;
<proc_def2> : ( tfexp, sigopt, hold, x, n, is_deced ) -> () = @{
RESET_TDF(@hold);
o_make_id_tagdef(out_tdfint32(UL(local_name(&@x->idname.name, tag_ent))),
if (@sigopt.no !=0) { OPTION(append_TDF(&@sigopt, @is_deced)); },
append_TDF(&@tfexp, 1));
INC_LIST;
SELECT_UNIT(tagdec_unit);
if (!@is_deced) {
o_make_id_tagdec(out_tdfint32(UL(non_local(&@x->idname.name,tag_ent))),
{},
if (@sigopt.no !=0) { OPTION(append_TDF(&@sigopt, 1)); },
o_proc);
INC_LIST;
}
@x->isdeffed=1;
if (!@is_deced) {@x->next = tagdecs; tagdecs = @x;}
@} ;
<query_type1> : () -> () = @{
query_t = lex_query;
@} ;
<query_type2> : () -> () = @{
query_t = lex_float__query;
@} ;
<query_type3> : () -> () = @{
query_t = lex_ptr__query;
@} ;
<query_type4> : () -> () = @{
query_t = lex_proc__query;
@} ;
<query_type5> : () -> () = @{
query_t = lex_offset__query;
@} ;
<range1_dec> : () -> ( hold ) = @{
SET_TDF(@hold, &g_lower);
@} ;
<range2> : ( hold ) -> () = @{
RESET_TDF(@hold);
g_upper = g_lower;
g_has_upper=0;
@} ;
<range3> : ( hold ) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold, &g_upper);
@} ;
<range4> : ( hold ) -> () = @{
RESET_TDF(@hold);
g_has_upper=1;
@} ;
<rllist1_dec> : () -> ( labx, hold ) = @{
SET_TDF(@hold,&@labx);
@} ;
<rllist2> : ( labx, hold ) -> () = @{
RESET_TDF(@hold);
o_make_caselim(append_TDF(&@labx,1),
append_TDF(&g_lower, g_has_upper),
append_TDF(&g_upper,1));
current_TDF->no = 1;
@} ;
<rllist3> : ( labx, hold ) -> () = @{
RESET_TDF(@hold);
o_make_caselim(append_TDF(&@labx,1),
append_TDF(&g_lower, g_has_upper),
append_TDF(&g_upper,1));
@} ;
<rllist4> : () -> () = @{
current_TDF->no++;
@} ;
<rmode1> : ( condexp, thenpt, elsept, hold ) -> () = @{
RESET_TDF(@hold);
o_rounding_mode_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
append_TDF(&@elsept,1));
@} ;
<rmodeopt1> : () -> () = @{
o_to_nearest;
@} ;
<shape1> : ( condexp, thenpt, elsept, hold ) -> () = @{
RESET_TDF(@hold);
o_shape_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
append_TDF(&@elsept,1));
@} ;
<shapechar> : () -> () = @{
Name * shtok = tokforcharsh(issigned);
o_shape_apply_token(make_tok(shtok), {});
@} ;
<shapedouble> : () -> () = @{
Name * shtok = tokfordoublesh();
o_shape_apply_token(make_tok(shtok), {});
@} ;
<shapefloat> : () -> () = @{
Name * shtok = tokforfloatsh();
o_shape_apply_token(make_tok(shtok), {});
@} ;
<shapeint> : () -> () = @{
Name * shtok = tokforintsh(issigned);
o_shape_apply_token(make_tok(shtok), {});
@} ;
<shapelong> : () -> () = @{
Name * shtok = tokforlongsh(issigned);
o_shape_apply_token(make_tok(shtok), {});
@} ;
<shapeptr2> : ( sh, hold ) -> () = @{
RESET_TDF(@hold);
o_pointer(o_alignment(append_TDF(&@sh,1)));
@} ;
<shapeshort> : () -> () = @{
Name * shtok = tokforshortsh(issigned);
o_shape_apply_token(make_tok(shtok), {});
@} ;
<shapetok2> : ( place, sh, hold, cu ) -> () = @{
RESET_TDF(@hold);
o_make_tokdef(out_tdfint32(UL(g_shtokname->unit_name)), {},
o_token_def(o_shape, {}, append_TDF(&@sh, 1)));
INC_LIST;
current_Unit = @cu;
RESET_TDF(@place);
@} ;
<shapetokchar> : () -> () = @{
* g_shtokname = *(tokforcharsh(issigned));
@} ;
<shapetokint> : () -> () = @{
* g_shtokname = *(tokforintsh(issigned));
@} ;
<shapetoklong> : () -> () = @{
* g_shtokname = *(tokforlongsh(issigned));
@} ;
<shptr1_dec> : () -> ( sh, hold ) = @{
SET_TDF(@hold, &@sh);
@} ;
<shtok1_dec> : () -> ( place, sh, hold, cu ) = @{
@place = current_TDF;
@cu = current_Unit;
select_tokdef_unit();
* g_shtokname = next_name(tok_ent);
SET_TDF(@hold, &@sh);
@} ;
<shtokdb> : () -> () = @{
* g_shtokname = *(tokfordoublesh());
@} ;
<shtokflt> : () -> () = @{
* g_shtokname = *(tokforfloatsh());
@} ;
<shtokshrt> : () -> () = @{
* g_shtokname = *(tokforshortsh(issigned));
@} ;
<signed_nat1> : ( condexp, thenpt, elsept, hold ) -> () = @{
RESET_TDF(@hold);
o_signed_nat_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
append_TDF(&@elsept,1));
@} ;
<signed_nat2> : () -> () = @{
o_make_signed_nat(out_tdfbool(0), out_tdfint32(intvalue));
@} ;
<signed_nat3> : () -> () = @{
o_make_signed_nat(out_tdfbool(1), out_tdfint32(intvalue));
@} ;
<signed_nat4> : () -> () = @{
o_make_signed_nat(out_tdfbool(0), out_tdfint32(cLINE));
@} ;
<signed_nat5_dec> : () -> ( nt, hold ) = @{
SET_TDF(@hold, &@nt);
@} ;
<signed_nat6> : ( nt, hold ) -> () = @{
RESET_TDF(@hold);
o_snat_from_nat(o_true, append_TDF(&@nt,1));
@} ;
<signed_nat7_dec> : () -> ( nt, hold ) = @{
SET_TDF(@hold, &@nt);
if (strcmp(lex_v.val.name, "+")) fail("Only + or - on NATs");
@} ;
<signed_nat8> : ( nt, hold ) -> () = @{
RESET_TDF(@hold);
o_snat_from_nat(o_false, append_TDF(&@nt,1));
@} ;
<signedornot1> : () -> () = @{
issigned = 1;
@} ;
<signedornot2> : () -> () = @{
issigned = 0;
@} ;
<sizeexp2> : ( sh, hold ) -> () = @{
RESET_TDF(@hold);
o_offset_pad(o_alignment(append_TDF(&@sh, 0)),
o_shape_offset(append_TDF(&@sh, 1)));
@} ;
<sortname1> : () -> () = @{
g_sname.sort = lex_v.t;
@} ;
<sortname2> : () -> () = @{
if(g_sname.sort == token_sort) {
fail("Token pars require result and parameter sorts");
}
g_sname.toksort= (TokSort*)0;
@} ;
<sortname3_dec> : () -> ( x, temp, old_tokpars ) = @{
/* @temp uninitialised */
@old_tokpars = g_tokpars;
@x = g_sname;
if (g_sname.sort != token_sort) {
fail("Only token pars require result and parameter sorts");
}
@} ;
<sortname4> : ( temp ) -> () = @{
@temp = g_tokpars;
@} ;
<sortname5> : ( x, temp, old_tokpars ) -> () = @{
TokSort * ts = MALLOC(TokSort);
ts->ressort = g_sname;
ts->pars = @temp;
g_tokpars = @old_tokpars;
@x.toksort = ts;
g_sname = @x;
@} ;
<snl1> : () -> () = @{
g_tokpars = MALLOC(Tokpar);
g_tokpars->par = g_sname;
g_tokpars->next = (Tokpar*)0;
@} ;
<snl2_dec> : () -> ( tmp ) = @{
@tmp = g_sname;
@} ;
<snl3> : ( tmp ) -> () = @{
Tokpar * x = MALLOC(Tokpar);
x->par = @tmp;
x->next = g_tokpars;
g_tokpars = x;
@} ;
<strtr1> : () -> () = @{
o_make_top;
@} ;
<struct1_dec> : () -> ( x ) = @{
char * n = lex_v.val.name;
@x = find_tok(n);
SELECT_UNIT(tokdef_unit);
if (@x!=(Tokdec*)0) fail("Struct name %s must be unique", n);
@x = MALLOC(Tokdec); NEW_IDNAME(@x->idname, n, tok_ent);
@x->sort.ressort.sort = shape_sort; @x->sort.pars = (Tokpar*)0;
@x->isdeffed = 1; @x->isused=0; @x->iskept=0;
g_lastfield = -1;
@} ;
<struct2> : ( x ) -> () = @{
o_make_tokdef(out_tdfint32(LOCNAME(@x->idname)), {},
o_token_def(o_shape, {},
o_compound(o_offset_add(
o_exp_apply_token(
o_make_tok(out_tdfint32(UL(g_lastfield))),{}),
o_shape_offset(append_TDF(&g_lastshape, 1))))))
INC_LIST;
@x->next = tokdecs;
tokdecs = @x;
@} ;
<szexp1_dec> : () -> ( sh, hold ) = @{
SET_TDF(@hold, &@sh);
@} ;
<tag1> : () -> () = @{
char * n =lex_v.val.name;
Tagdec * x = find_tag(n);
if (x == (Tagdec*)0) { fail("Ident %s not declared", n); }
x->isused = 1;
make_tag(&x->idname.name);
@} ;
<tag_dec1_dec> : () -> ( tdaccopt, sigopt, hold, x ) = @{
/* @sigopt uninitialised */
char * n =lex_v.val.name;
@x = find_tag(n);
if (@x != (Tagdec*)0) fail("Tag %s declared twice", n);
SELECT_UNIT(tagdec_unit);
@x = MALLOC(Tagdec); NEW_IDNAME(@x->idname, n, tag_ent);
@x->isdeffed = 0; @x->hassh = 1; @x->iskept=0; @x->iscommon=0;
@x->isused = 0;
SET_TDF(@hold, &@tdaccopt);
@} ;
<tag_dec2> : ( x ) -> () = @{
g_shtokname = &@x->sh.shtok;
@} ;
<tag_dec3> : ( tdaccopt, sigopt, hold, x ) -> () = @{
RESET_TDF(@hold);
o_make_var_tagdec(out_tdfint32(LOCNAME(@x->idname)),
if (@tdaccopt.no !=0) { OPTION(append_TDF(&@tdaccopt, 1)); },
if (@sigopt.no !=0) { OPTION(append_TDF(&@sigopt, 1)); },
o_shape_apply_token(make_tok(&@x->sh.shtok), {}));
INC_LIST;
@x->next = tagdecs;
@x->isvar = 1;
tagdecs = @x;
@} ;
<tag_dec4> : ( tdaccopt, sigopt, hold, x ) -> () = @{
RESET_TDF(@hold);
o_make_id_tagdec(out_tdfint32(LOCNAME(@x->idname)),
if (@tdaccopt.no !=0) { OPTION(append_TDF(&@tdaccopt, 1)); },
if (@sigopt.no !=0) { OPTION(append_TDF(&@sigopt, 1)); },
o_shape_apply_token(make_tok(&@x->sh.shtok), {}));
INC_LIST;
@x->next = tagdecs;
@x->isvar = 0;
tagdecs = @x;
@} ;
<tag_dec5> : ( tdaccopt, sigopt, hold, x ) -> () = @{
RESET_TDF(@hold);
@x->iscommon = 1;
o_common_tagdec(out_tdfint32(LOCNAME(@x->idname)),
if (@tdaccopt.no !=0) { OPTION(append_TDF(&@tdaccopt, 1)); },
if (@sigopt.no !=0) { OPTION(append_TDF(&@sigopt, 1)); },
o_shape_apply_token(make_tok(&@x->sh.shtok), {}));
INC_LIST;
@x->next = tagdecs;
@x->isvar = 1;
tagdecs = @x;
@} ;
<tag_dec6> : ( sigopt, hold ) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold, &@sigopt);
@} ;
<tag_def10> : ( x ) -> () = @{
o_make_value(o_shape_apply_token(make_tok(&@x->sh.shtok), {}));
@} ;
<tag_def12> : ( tfexp, hold, x, is_deced, v, s ) -> () = @{
RESET_TDF(@hold);
o_make_var_tagdef(out_tdfint32(UL(local_name(&@x->idname.name, tag_ent))),
{}, {}, append_TDF(&@tfexp, 1));
INC_LIST;
SELECT_UNIT(tagdec_unit);
if (!@is_deced) {
o_make_var_tagdec(out_tdfint32(UL(non_local(&@x->idname.name,tag_ent))),
{}, {},
o_nof(o_make_nat(out_tdfint32(UL(strlen(@s)+1))),
o_integer(append_TDF(&@v, 0))));
INC_LIST;
}
@x->isdeffed=1;
if (!@is_deced) { @x->next = tagdecs; tagdecs = @x; }
@} ;
<tag_def1_dec> : () -> ( tfexp, sigopt, hold, x, n, is_deced ) = @{
/* @tfexp uninitialised */
@n =lex_v.val.name;
@x = find_tag(@n);
SELECT_UNIT(tagdef_unit);
if(@x!= (Tagdec*)0) {
if (@x->isdeffed && !@x->iscommon) fail("Tag %s defined twice", @n);
if (!@x->isvar) fail("Tag %s declared as non-variable", @n);
@is_deced = 1;
} else {
@x = MALLOC(Tagdec);
@x->hassh = 0; @x->isvar=1; @x->iskept=0; @x->iscommon = 0;
@x->isused=0;
NEW_IDNAME(@x->idname, @n, tag_ent);
@is_deced=0;
}
SET_TDF(@hold, &@sigopt);
@} ;
<tag_def2> : ( tfexp, hold, x, n ) -> () = @{
RESET_TDF(@hold);
if (!@x->hassh) fail("No declaration shape for %s", @n);
SET_TDF(@hold, &@tfexp);
@} ;
<tag_def3> : ( tfexp, sigopt, hold, x ) -> () = @{
RESET_TDF(@hold);
o_make_var_tagdef(out_tdfint32(UL(non_local(&@x->idname.name, tag_ent))),
{},
if (@sigopt.no !=0) { OPTION(append_TDF(&@sigopt, 1)); },
append_TDF(&@tfexp, 1));
INC_LIST;
@x->isdeffed = 1;
@} ;
<tag_def4> : ( hold, x, n ) -> () = @{
RESET_TDF(@hold);
if (@x->hassh) fail("Two declaration shapes for %s", @n);
g_shtokname = &@x->sh.shtok;
@} ;
<tag_def5> : ( tfexp, hold ) -> () = @{
SET_TDF(@hold, &@tfexp);
@} ;
<tag_def6> : ( tfexp, sigopt, hold, x, is_deced ) -> () = @{
RESET_TDF(@hold);
o_make_var_tagdef(out_tdfint32(UL(local_name(&@x->idname.name, tag_ent))),
{},
if (@sigopt.no !=0 ) { OPTION(append_TDF(&@sigopt, @is_deced)); },
append_TDF(&@tfexp, 1));
INC_LIST;
SELECT_UNIT(tagdec_unit);
if (!@is_deced) {
o_make_var_tagdec(out_tdfint32(UL(non_local(&@x->idname.name,tag_ent))),
{},
if (@sigopt.no !=0 ) { OPTION(append_TDF(&@sigopt, 1)); },
o_shape_apply_token(make_tok(&@x->sh.shtok), {}));
INC_LIST;
}
@x->isdeffed=1; @x->hassh =1;
if (!@is_deced) { @x->next = tagdecs; tagdecs = @x; }
@} ;
<tag_def7_dec> : () -> ( tfexp, sigopt, hold, x, n, is_deced ) = @{
/* @tfexp uninitialised */
@n =lex_v.val.name;
@x = find_tag(@n);
SELECT_UNIT(tagdef_unit);
if(@x!= (Tagdec*)0) {
if (@x->isdeffed && !@x->iscommon) fail("Tag %s defined twice", @n);
if (@x->isvar) fail("Tag %s declared as variable", @n);
@is_deced = 1;
} else {
@x = MALLOC(Tagdec);
@x->hassh = 0; @x->isvar=0; @x->iskept=0; @x->iscommon = 0;
@x->isused = 0;
NEW_IDNAME(@x->idname, @n, tag_ent);
@is_deced = 0;
}
SET_TDF(@hold, &@sigopt);
@} ;
<tag_def8> : ( tfexp, sigopt, hold, x ) -> () = @{
RESET_TDF(@hold);
o_make_id_tagdef(out_tdfint32(UL(non_local(&@x->idname.name, tag_ent))),
if (@sigopt.no !=0) { OPTION(append_TDF(&@sigopt, 1)); },
append_TDF(&@tfexp, 1));
INC_LIST;
@x->isdeffed = 1;
@} ;
<tag_def9> : ( tfexp, sigopt, hold, x, is_deced ) -> () = @{
RESET_TDF(@hold);
o_make_id_tagdef(out_tdfint32(UL(local_name(&@x->idname.name, tag_ent))),
if (@sigopt.no !=0) { OPTION(append_TDF(&@sigopt, @is_deced)); },
append_TDF(&@tfexp, 1));
INC_LIST;
SELECT_UNIT(tagdec_unit);
if (!@is_deced) {
o_make_id_tagdec(out_tdfint32(UL(non_local(&@x->idname.name,tag_ent))),
{},
if (@sigopt.no !=0) { OPTION(append_TDF(&@sigopt, 1)); },
o_shape_apply_token(make_tok(&@x->sh.shtok), {}));
INC_LIST;
}
@x->isdeffed=1; @x->hassh =1;
if (!@is_deced) { @x->next = tagdecs; tagdecs = @x; }
@} ;
<tagsa1_dec> : () -> ( accopt, hold, x, has_vis ) = @{
/* @has_vis uninitialised */
char * n =lex_v.val.name;
@x = find_tag(n);
if (@x != (Tagdec*)0) fail("Ident %s already declared", n);
@x = MALLOC(Tagdec);
@x->hassh = 2; @x->isvar =1; @x->isdeffed = 1; @x->iskept=0;
NEW_IDNAME(@x->idname, n, tag_ent);
g_has_vis =0;
SET_TDF(@hold, &@accopt);
@} ;
<tagshacc2> : ( hold, x, has_vis ) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold, &@x->sh.tdfsh);
@has_vis = g_has_vis;
@} ;
<tagshacc3> : ( accopt, hold, x, has_vis ) -> () = @{
RESET_TDF(@hold);
o_make_tagshacc( append_TDF(&@x->sh.tdfsh, 0),
if(@accopt.no != 0) {OPTION(append_TDF(&@accopt,1));},
make_tag(&@x->idname.name));
if (@has_vis) {
Tagdec * y = MALLOC(Tagdec);
*y = *@x;
y->next = tagdecs;
tagdecs = y;
}
@x->next = localdecs;
localdecs = @x;
@} ;
<tagshacc_l1> : () -> () = @{
current_TDF->no =0;
@} ;
<tagshacc_l2> : () -> () = @{
current_TDF->no++;
@} ;
<tcall1_dec> : () -> ( fn ) = @{
@fn = *current_TDF;
INIT_TDF(current_TDF);
@} ;
<tcall2> : ( fn ) -> () = @{
TDF cees;
cees = *current_TDF;
INIT_TDF(current_TDF);
o_tail_call(do_procprops(g_ce_v*2),
append_TDF(&@fn,1), append_TDF(&cees,1));
@} ;
<tgdef10_dec> : ( hold ) -> ( v ) = @{
RESET_TDF(@hold);
SET_TDF(@hold, &@v);
@} ;
<tgdef11_dec> : ( tfexp, hold, x, n, v ) -> ( s ) = @{
@s = lex_v.val.name;
if (@x->hassh) fail("Two declaration shapes for %s", @n);
RESET_TDF(@hold);
SET_TDF(@hold, &@tfexp);
o_make_nof_int(append_TDF(&@v, 0),
o_make_string(out_tdfstring_bytes(@s, 8, UI(strlen(@s)+1))));
@} ;
<tmode1> : ( condexp, thenpt, elsept, hold ) -> () = @{
RESET_TDF(@hold);
o_transfer_mode_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
append_TDF(&@elsept,1));
@} ;
<tok1> : () -> () = @{
Tokdec * td = lex_v.val.tokname;
if (td->isparam) {
o_token_apply_token(make_tok(&td->idname.name), {});
} else {
make_tok(&td->idname.name);
}
/* token should only be expanded as parameter of a token */
@} ;
<tok2_dec> : () -> ( holdtd ) = @{
@holdtd = g_tok_defn;
@} ;
<tok3> : ( holdtd ) -> () = @{
o_use_tokdef(append_TDF(&g_tok_defn,1));
g_tok_defn = @holdtd;
@} ;
<tok_dec1_dec> : () -> ( sigopt, hold, x ) = @{
char *n = lex_v.val.name;
@x = find_tok(n);
if (@x != (Tokdec *)0) fail("Token %s declared twice", n);
SELECT_UNIT(tokdec_unit);
@x = MALLOC(Tokdec);
NEW_IDNAME(@x->idname, n, tok_ent);
SET_TDF(@hold, &@sigopt);
@} ;
<tok_dec2> : ( sigopt, hold, x ) -> () = @{
RESET_TDF(@hold);
@x->sort.ressort = g_sname;
@x->sort.pars = g_tokpars;
@x->next = tokdecs;
@x->isdeffed = 0; @x->isused = 0; @x->iskept=0; @x->isparam=0;
tokdecs = @x;
o_make_tokdec(out_tdfint32(LOCNAME(@x->idname)),
if (@sigopt.no != 0) { OPTION(append_TDF(&@sigopt, 1)); },
out_toksort(&@x->sort));
INC_LIST;
@} ;
<tok_def0> : () -> () = @{
search_for_toks = 0;
@} ;
<tok_def1_dec> : () -> ( holdtd, sigopt, hold, x, is_deced ) = @{
char *n = lex_v.val.name;
@x = find_tok(n);
@holdtd = g_tok_defn;
SELECT_UNIT(tokdef_unit);
search_for_toks = 1;
if (@x != (Tokdec *)0) {
if (@x->isdeffed) fail("Token %s defined twice", n);
@is_deced = 1;
} else {
@x = MALLOC(Tokdec);
NEW_IDNAME(@x->idname, n, tok_ent);
@is_deced = 0;
}
SET_TDF(@hold, &@sigopt);
@} ;
<tok_def2> : ( holdtd, sigopt, hold, x, is_deced ) -> () = @{
RESET_TDF(@hold);
@x->sort = g_toksort;
@x->isdeffed =1; @x->iskept=0; @x->isparam = 0;
o_make_tokdef(out_tdfint32(UL(local_name(&@x->idname.name,tok_ent))),
if (@sigopt.no != 0) { OPTION(append_TDF(&@sigopt, 1)); },
append_TDF(&g_tok_defn, 1));
INC_LIST;
if (!@is_deced) { @x->next = tokdecs; tokdecs = @x; @x->isused=0; }
g_tok_defn = @holdtd;
@} ;
<tok_dn1_dec> : () -> ( old_tokformals ) = @{
@old_tokformals = g_tokformals;
@} ;
<tok_dn2> : ( old_tokformals ) -> () = @{
Tokdec * old_tokdecs = tokdecs;
Tokdec * tokformals = g_tokformals;
TDF * hold = current_TDF;
Tokpar * tp = (Tokpar*)0;
Sort sn;
Tokdec * tfrev = (Tokdec*)0;
while (g_tokformals != (Tokdec*)0) { /* the wrong way round!! */
Tokdec * x = MALLOC(Tokdec);
*x = *g_tokformals;
x->next = tfrev;
tfrev = x;
g_tokformals = g_tokformals->next;
}
sn = g_sname;
current_TDF = &g_tok_defn;
INIT_TDF(current_TDF);
o_token_def( out_sort(&sn),
{
while(tfrev != (Tokdec*)0) {
Tokdec * x = tfrev->next;
LIST_ELEM(
o_make_tokformals(
out_sort(&tfrev->sort.ressort),
out_tdfint32(LOCNAME(tfrev->idname))));
tfrev->isparam = 1;
tfrev->next = tokdecs;
tokdecs = tfrev;
tfrev = x;
}
},
analyse_sort(sn.sort));
g_toksort.ressort = sn;
while (tokformals != (Tokdec*)0) {
Tokpar * p = MALLOC(Tokpar);
p->par = tokformals->sort.ressort;
p->next = tp;
tokformals = tokformals->next;
tp = p;
}
g_toksort.pars = tp;
RESET_TDF(hold);
tokdecs = old_tokdecs;
g_tokformals = @old_tokformals;
@} ;
<tok_fml1_dec> : () -> ( x ) = @{
char * n = lex_v.val.name;
@x = find_tok(n);
if (@x!=(Tokdec*)0) fail("Token parameter name %s must be unique", n);
@x = MALLOC(Tokdec); NEW_IDNAME(@x->idname, n, tok_ent);
@x->isdeffed = 1; @x->isused = 0; @x->iskept=0;
@x->next = (Tokdec*)0;
@} ;
<tok_fml2> : ( x ) -> () = @{
@x->sort.ressort = g_sname;
@x->sort.pars = (Tokpar*)0; /* no pars in formal pars */
g_tokformals = @x;
@} ;
<tok_fml3> : ( x ) -> () = @{
@x->sort.ressort = g_sname;
@x->sort.pars = (Tokpar*)0; /* no pars in formal pars */
@x->next = g_tokformals;
g_tokformals = @x;
@} ;
<tok_fml_opt1> : () -> () = @{
g_tokpars = (Tokpar*)0;
@} ;
<untidy1> : () -> () = @{
g_unt = 0;
@} ;
<untidy2> : () -> () = @{
g_unt = 1;
@} ;
<untidy3> : () -> () = @{
g_unt = 3;
@} ;
<untidy4> : () -> () = @{
g_unt = 2;
@} ;
<variety1> : ( condexp, thenpt, elsept, hold ) -> () = @{
RESET_TDF(@hold);
o_var_cond(append_TDF(&@condexp,1), append_TDF(&@thenpt,1),
append_TDF(&@elsept,1));
@} ;
<variety2_dec> : () -> ( first, second, hold ) = @{
/* @second uninitialised */
SET_TDF(@hold, &@first);
@} ;
<variety3> : ( second, hold ) -> () = @{
RESET_TDF(@hold);
SET_TDF(@hold, &@second);
@} ;
<variety4> : ( first, second, hold ) -> () = @{
RESET_TDF(@hold);
o_var_limits(append_TDF(&@first,1), append_TDF(&@second,1));
@} ;
<varietychar> : () -> () = @{
o_var_limits(
o_make_signed_nat(out_tdfbool(issigned),
out_tdfint32(UL((issigned)?MINSC:0))),
o_make_signed_nat(out_tdfbool(0),
out_tdfint32(UL((issigned)?MAXSC:MAXUSC))));
@} ;
<varietyint> : () -> () = @{
o_var_limits(
o_make_signed_nat(out_tdfbool(issigned),
out_tdfint32(UL((issigned)?MINSI:0))),
o_make_signed_nat(out_tdfbool(0),
out_tdfint32(UL((issigned)?MAXSI:MAXUSI))));
@} ;
<varietylong> : () -> () = @{
o_var_limits(
o_make_signed_nat(out_tdfbool(issigned),
out_tdfint32(UL((issigned)?MINSL:0))),
o_make_signed_nat(out_tdfbool(0),
out_tdfint32(UL((issigned)?MAXSL:MAXUSL))));
@} ;
<varietyopt1> : () -> () = @{
/* unsigned char */
o_var_limits(
o_make_signed_nat(out_tdfbool(0), out_tdfint32(UL(0))),
o_make_signed_nat(out_tdfbool(0), out_tdfint32(UL(255))));
@} ;
<varietyshort> : () -> () = @{
o_var_limits(
o_make_signed_nat(out_tdfbool(issigned),
out_tdfint32(UL((issigned)?MINSS:0))),
o_make_signed_nat(out_tdfbool(0),
out_tdfint32(UL((issigned)?MAXSS:MAXUSS))));
@} ;
<vpar1> : () -> () = @{
current_TDF->no=1;
@} ;
<vpar2> : () -> () = @{
current_TDF->no=0;
@} ;
<syntax_error> : () -> () = @{
fail("Syntax error");
@} ;
%trailer% @{
@}, @{
#endif
@} ;