diff --git a/lang/m2/comp/LLlex.c b/lang/m2/comp/LLlex.c index b053e9312..823b1b005 100644 --- a/lang/m2/comp/LLlex.c +++ b/lang/m2/comp/LLlex.c @@ -32,9 +32,9 @@ long str2long(); -struct token dot, +t_token dot, aside; -struct type *toktype; +t_type *toktype; int idfsize = IDFSIZE; int ForeignFlag; #ifdef DEBUG @@ -236,7 +236,7 @@ LLlex() /* LLlex() is the Lexical Analyzer. The putting aside of tokens is taken into account. */ - register struct token *tk = ˙ + register t_token *tk = ˙ char buf[(IDFSIZE > NUMSIZE ? IDFSIZE : NUMSIZE) + 2]; register int ch, nch; @@ -339,7 +339,7 @@ again: case STIDF: { register char *tag = &buf[0]; - register struct idf *id; + register t_idf *id; do { if (tag - buf < idfsize) *tag++ = ch; diff --git a/lang/m2/comp/LLlex.h b/lang/m2/comp/LLlex.h index 056d981ae..ecfa892e9 100644 --- a/lang/m2/comp/LLlex.h +++ b/lang/m2/comp/LLlex.h @@ -32,13 +32,15 @@ struct token { } tk_data; }; +typedef struct token t_token; + #define TOK_IDF tk_data.tk_idf #define TOK_STR tk_data.tk_str->s_str #define TOK_SLE tk_data.tk_str->s_length #define TOK_INT tk_data.tk_int #define TOK_REL tk_data.tk_real -extern struct token dot, aside; +extern t_token dot, aside; extern struct type *toktype; #define DOT dot.tk_symb diff --git a/lang/m2/comp/LLmessage.c b/lang/m2/comp/LLmessage.c index ff87da62d..48b282791 100644 --- a/lang/m2/comp/LLmessage.c +++ b/lang/m2/comp/LLmessage.c @@ -24,7 +24,7 @@ #include "Lpars.h" extern char *symbol2str(); -extern struct idf *gen_anon_idf(); +extern t_idf *gen_anon_idf(); LLmessage(tk) register int tk; @@ -32,7 +32,7 @@ LLmessage(tk) if (tk > 0) { /* if (tk > 0), it represents the token to be inserted. */ - register struct token *dotp = ˙ + register t_token *dotp = ˙ error("%s missing", symbol2str(tk)); diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile index d486ec47a..ee950e150 100644 --- a/lang/m2/comp/Makefile +++ b/lang/m2/comp/Makefile @@ -39,7 +39,7 @@ OBJ = $(COBJ) $(LOBJ) Lpars.o GENH= errout.h\ idfsize.h numsize.h strsize.h target_sizes.h \ - inputtype.h maxset.h density.h\ + inputtype.h maxset.h density.h squeeze.h \ def.h debugcst.h type.h Lpars.h node.h desig.h HFILES= LLlex.h\ chk_expr.h class.h const.h debug.h f_info.h idf.h\ diff --git a/lang/m2/comp/Parameters b/lang/m2/comp/Parameters index 1e16606e2..b3ef162b1 100644 --- a/lang/m2/comp/Parameters +++ b/lang/m2/comp/Parameters @@ -59,3 +59,9 @@ !File: density.h #define DENSITY 3 /* see casestat.C for an explanation */ + + +!File: squeeze.h +#undef SQUEEZE 1 /* define on "small" machines */ + + diff --git a/lang/m2/comp/casestat.C b/lang/m2/comp/casestat.C index d3a36a489..3a3f9acf0 100644 --- a/lang/m2/comp/casestat.C +++ b/lang/m2/comp/casestat.C @@ -24,6 +24,7 @@ #include #include +#include "squeeze.h" #include "Lpars.h" #include "type.h" #include "LLlex.h" @@ -38,7 +39,7 @@ struct switch_hdr { label sh_break; /* label of statement after this one */ label sh_default; /* label of ELSE part, or 0 */ int sh_nrofentries; /* number of cases */ - struct type *sh_type; /* type of case expression */ + t_type *sh_type; /* type of case expression */ arith sh_lowerbd; /* lowest case label */ arith sh_upperbd; /* highest case label */ struct case_entry *sh_entries; /* the cases with their generated @@ -65,7 +66,7 @@ struct case_entry { #define compact(nr, low, up) (nr != 0 && (up - low) / nr <= DENSITY) CaseCode(nd, exitlabel) - struct node *nd; + t_node *nd; label exitlabel; { /* Check the expression, stack a new case header and @@ -74,7 +75,7 @@ CaseCode(nd, exitlabel) LOOP-statement, or 0. */ register struct switch_hdr *sh = new_switch_hdr(); - register struct node *pnode = nd; + register t_node *pnode = nd; register struct case_entry *ce; register arith val; label CaseDescrLab; @@ -151,7 +152,7 @@ CaseCode(nd, exitlabel) else if (sh->sh_default) C_rom_ilb(sh->sh_default); else C_rom_ucon("0", pointer_size); } - C_lae_dlb(CaseDescrLab, (arith)0); /* perform the switch */ + c_lae_dlb(CaseDescrLab); /* perform the switch */ C_csa(word_size); } else { @@ -164,7 +165,7 @@ CaseCode(nd, exitlabel) C_rom_cst(ce->ce_value); C_rom_ilb(ce->ce_label); } - C_lae_dlb(CaseDescrLab, (arith)0); /* perform the switch */ + c_lae_dlb(CaseDescrLab); /* perform the switch */ C_csb(word_size); } @@ -174,8 +175,9 @@ CaseCode(nd, exitlabel) while (pnode = pnode->nd_right) { if (pnode->nd_class == Link && pnode->nd_symb == '|') { if (pnode->nd_left) { - C_df_ilb(pnode->nd_lab); - WalkNode(pnode->nd_left->nd_right, exitlabel); + LblWalkNode(pnode->nd_lab, + pnode->nd_left->nd_right, + exitlabel); C_bra(sh->sh_break); } } @@ -184,8 +186,7 @@ CaseCode(nd, exitlabel) */ assert(sh->sh_default != 0); - C_df_ilb(sh->sh_default); - WalkNode(pnode, exitlabel); + LblWalkNode(sh->sh_default, pnode, exitlabel); break; } } @@ -214,7 +215,7 @@ FreeSh(sh) AddCases(sh, node, lbl) struct switch_hdr *sh; - register struct node *node; + register t_node *node; label lbl; { /* Add case labels to the case label list @@ -246,7 +247,7 @@ AddCases(sh, node, lbl) AddOneCase(sh, node, lbl) register struct switch_hdr *sh; - struct node *node; + t_node *node; label lbl; { register struct case_entry *ce = new_case_entry(); diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c index d17a3ca8b..e3e34baa2 100644 --- a/lang/m2/comp/chk_expr.c +++ b/lang/m2/comp/chk_expr.c @@ -36,34 +36,37 @@ extern char *symbol2str(); extern char *sprint(); STATIC int -Xerror(nd, mess, edf) - struct node *nd; - char *mess; - register struct def *edf; +df_error(nd, mess, edf) + t_node *nd; /* node on which error occurred */ + char *mess; /* error message */ + register t_def *edf; /* do we have a name? */ { if (edf) { if (edf->df_kind != D_ERROR) { node_error(nd,"\"%s\": %s", edf->df_idf->id_text, mess); } } - else node_error(nd, "%s", mess); + else node_error(nd, mess); return 0; } MkCoercion(pnd, tp) - struct node **pnd; - register struct type *tp; + t_node **pnd; + register t_type *tp; { - register struct node *nd = *pnd; - register struct type *nd_tp = nd->nd_type; - extern int pass_1; - int w = 0; + /* Make a coercion from the node indicated by *pnd to the + type indicated by tp. + */ + register t_node *nd = *pnd; + register t_type *nd_tp = nd->nd_type; + extern int pass_1; + int w = 0; - if (nd_tp == tp) return; - if (nd_tp->tp_fund == T_STRING) return; + if (nd_tp == tp || nd_tp->tp_fund == T_STRING /* Why ??? */) return; nd_tp = BaseType(nd_tp); if (nd->nd_class == Value && - (nd_tp->tp_fund != T_REAL && tp->tp_fund != T_REAL)) { + nd_tp->tp_fund != T_REAL && + tp->tp_fund != T_REAL) { switch(tp->tp_fund) { case T_SUBRANGE: if (! chk_bounds(tp->sub_lb, nd->nd_INT, @@ -123,7 +126,7 @@ MkCoercion(pnd, tp) int ChkVariable(expp) - register struct node *expp; + register t_node *expp; { /* Check that "expp" indicates an item that can be assigned to. @@ -132,17 +135,17 @@ ChkVariable(expp) return ChkDesignator(expp) && ( expp->nd_class != Def || ( expp->nd_def->df_kind & (D_FIELD|D_VARIABLE)) || - Xerror(expp, "variable expected", expp->nd_def)); + df_error(expp, "variable expected", expp->nd_def)); } STATIC int ChkArrow(expp) - register struct node *expp; + register t_node *expp; { /* Check an application of the '^' operator. The operand must be a variable of a pointer type. */ - register struct type *tp; + register t_type *tp; assert(expp->nd_class == Arrow); assert(expp->nd_symb == '^'); @@ -164,7 +167,7 @@ ChkArrow(expp) STATIC int ChkArr(expp) - register struct node *expp; + register t_node *expp; { /* Check an array selection. The left hand side must be a variable of an array type, @@ -172,7 +175,7 @@ ChkArr(expp) assignment compatible with the array-index. */ - register struct type *tpl; + register t_type *tpl; assert(expp->nd_class == Arrsel); assert(expp->nd_symb == '['); @@ -180,6 +183,8 @@ ChkArr(expp) expp->nd_type = error_type; if (! (ChkVariable(expp->nd_left) & ChkExpression(expp->nd_right))) { + /* Bitwise and, because we want them both evaluated. + */ return 0; } @@ -204,7 +209,7 @@ ChkArr(expp) #ifdef DEBUG STATIC int ChkValue(expp) - struct node *expp; + t_node *expp; { switch(expp->nd_symb) { case REAL: @@ -221,12 +226,12 @@ ChkValue(expp) STATIC int ChkLinkOrName(expp) - register struct node *expp; + register t_node *expp; { /* Check either an ID or a construction of the form ID.ID [ .ID ]* */ - register struct def *df; + register t_def *df; expp->nd_type = error_type; @@ -239,7 +244,7 @@ ChkLinkOrName(expp) /* A selection from a record or a module. Modules also have a record type. */ - register struct node *left = expp->nd_left; + register t_node *left = expp->nd_left; assert(expp->nd_symb == '.'); @@ -250,7 +255,7 @@ ChkLinkOrName(expp) !(left->nd_def->df_kind & (D_MODULE|D_VARIABLE|D_FIELD)) ) ) { - return Xerror(left, "illegal selection", left->nd_def); + return df_error(left, "illegal selection", left->nd_def); } if (left->nd_type->tp_fund != T_RECORD) { node_error(left, "illegal selection"); @@ -268,7 +273,9 @@ ChkLinkOrName(expp) /* Fields of a record are always D_QEXPORTED, so ... */ -Xerror(expp, "not exported from qualifying module", df); + df_error(expp, + "not exported from qualifying module", + df); } if (!(left->nd_class == Def && @@ -286,12 +293,12 @@ Xerror(expp, "not exported from qualifying module", df); STATIC int ChkExLinkOrName(expp) - register struct node *expp; + register t_node *expp; { /* Check either an ID or an ID.ID [.ID]* occurring in an expression. */ - register struct def *df; + register t_def *df; if (! ChkLinkOrName(expp)) return 0; @@ -302,6 +309,7 @@ ChkExLinkOrName(expp) */ if (df->df_type->tp_fund == T_SET) { expp->nd_class = Set; + inc_refcount(expp->nd_set); } else expp->nd_class = Value; if (df->df_kind == D_ENUM) { @@ -314,23 +322,11 @@ ChkExLinkOrName(expp) assert(df->df_kind == D_CONST); expp->nd_token = df->con_const; expp->nd_lineno = ln; - if (expp->nd_class == Set) { - register int i = - (unsigned) expp->nd_type->tp_size / - (unsigned) word_size; - register arith *p, *q; - - p = expp->nd_set; - q = (arith *) Malloc((unsigned) i * sizeof(arith)); - expp->nd_set = q; - while (i--) *q++ = *p++; - } } } if (!(df->df_kind & D_VALUE)) { - Xerror(expp, "value expected", df); - return 0; + return df_error(expp, "value expected", df); } if (df->df_kind == D_PROCEDURE) { @@ -341,7 +337,8 @@ ChkExLinkOrName(expp) /* Address of standard or nested procedure taken. */ -node_error(expp, "standard or local procedures may not be assigned"); + node_error(expp, + "standard or local procedures may not be assigned"); return 0; } } @@ -351,8 +348,8 @@ node_error(expp, "standard or local procedures may not be assigned"); STATIC int ChkEl(expr, tp) - register struct node **expr; - struct type *tp; + register t_node **expr; + t_type *tp; { return ChkExpression(*expr) && ChkCompat(expr, tp, "set element"); @@ -360,15 +357,15 @@ ChkEl(expr, tp) STATIC int ChkElement(expp, tp, set) - struct node **expp; - struct type *tp; + t_node **expp; + t_type *tp; arith *set; { /* Check elements of a set. This routine may call itself recursively. Also try to compute the set! */ - register struct node *expr = *expp; + register t_node *expr = *expp; register unsigned int i; arith lo, hi, low, high; @@ -419,17 +416,38 @@ ChkElement(expp, tp, set) return 1; } +arith * +MkSet(size) + unsigned size; +{ + register arith *s; + + size += sizeof(arith); + s = (arith *) Malloc(size); + clear((char *) s , size); + s++; + inc_refcount(s); + return s; +} + +FreeSet(s) + register arith *s; +{ + if (refcount(s) <= 0) { + free((char *) (s-1)); + } +} + STATIC int ChkSet(expp) - register struct node *expp; + register t_node *expp; { /* Check the legality of a SET aggregate, and try to evaluate it compile time. Unfortunately this is all rather complicated. */ - register struct type *tp; - register struct node *nd; - register struct def *df; - unsigned size; + register t_type *tp; + register t_node *nd; + register t_def *df; int retval = 1; int SetIsConstant = 1; @@ -449,10 +467,7 @@ ChkSet(expp) if (!is_type(df) || (df->df_type->tp_fund != T_SET)) { - if (df->df_kind != D_ERROR) { - Xerror(nd, "not a SET type", df); - } - return 0; + return df_error(nd, "not a SET type", df); } tp = df->df_type; FreeNode(nd); @@ -466,9 +481,8 @@ ChkSet(expp) /* Now check the elements given, and try to compute a constant set. First allocate room for the set. */ - size = tp->tp_size * (sizeof(arith) / word_size); - expp->nd_set = (arith *) Malloc(size); - clear((char *) (expp->nd_set) , size); + + expp->nd_set = MkSet((unsigned)(tp->tp_size) * (sizeof(arith) / (int) word_size)); /* Now check the elements, one by one */ @@ -490,25 +504,26 @@ ChkSet(expp) return retval; } -STATIC struct node * +STATIC t_node * nextarg(argp, edf) - struct node **argp; - struct def *edf; + t_node **argp; + t_def *edf; { - register struct node *arg = (*argp)->nd_right; + register t_node *arg = (*argp)->nd_right; if (! arg) { - return (struct node *)Xerror(*argp, "too few arguments supplied", edf); + return (t_node *) + df_error(*argp, "too few arguments supplied", edf); } *argp = arg; return arg->nd_left; } -STATIC struct node * +STATIC t_node * getarg(argp, bases, designator, edf) - struct node **argp; - struct def *edf; + t_node **argp; + t_def *edf; { /* This routine is used to fetch the next argument from an argument list. The argument list is indicated by "argp". @@ -518,9 +533,10 @@ getarg(argp, bases, designator, edf) that it must be a designator and may not be a register variable. */ - register struct node *left = nextarg(argp, edf); + register t_node *left = nextarg(argp, edf); - if (!left || (designator ? !ChkVariable(left) : !ChkExpression(left))) { + if (! left || + ! (designator ? ChkVariable(left) : ChkExpression(left))) { return 0; } @@ -529,38 +545,40 @@ getarg(argp, bases, designator, edf) } if (bases) { - struct type *tp = BaseType(left->nd_type); + t_type *tp = BaseType(left->nd_type); - MkCoercion(&((*argp)->nd_left), tp); + if (! designator) MkCoercion(&((*argp)->nd_left), tp); left = (*argp)->nd_left; if (!(tp->tp_fund & bases)) { - return (struct node *)Xerror(left, "unexpected parameter type", edf); + return (t_node *) + df_error(left, "unexpected parameter type", edf); } } return left; } -STATIC struct node * +STATIC t_node * getname(argp, kinds, bases, edf) - struct node **argp; - struct def *edf; + t_node **argp; + t_def *edf; { /* Get the next argument from argument list "argp". The argument must indicate a definition, and the definition kind must be one of "kinds". */ - register struct node *left = nextarg(argp, edf); + register t_node *left = nextarg(argp, edf); if (!left || ! ChkDesignator(left)) return 0; if (left->nd_class != Def) { - return (struct node *)Xerror(left, "identifier expected", edf); + return (t_node *)df_error(left, "identifier expected", edf); } if (!(left->nd_def->df_kind & kinds) || (bases && !(left->nd_type->tp_fund & bases))) { - return (struct node *)Xerror(left, "unexpected parameter type", edf); + return (t_node *) + df_error(left, "unexpected parameter type", edf); } return left; @@ -568,12 +586,12 @@ getname(argp, kinds, bases, edf) STATIC int ChkProcCall(expp) - struct node *expp; + t_node *expp; { /* Check a procedure call */ - register struct node *left; - struct def *edf = 0; + register t_node *left; + t_def *edf = 0; register struct paramlist *param; int retval = 1; int cnt = 0; @@ -613,7 +631,7 @@ ChkProcCall(expp) } if (expp->nd_right) { - Xerror(expp->nd_right, "too many parameters supplied", edf); + df_error(expp->nd_right, "too many parameters supplied", edf); while (expp->nd_right) { getarg(&expp, 0, 0, edf); } @@ -625,7 +643,7 @@ ChkProcCall(expp) int ChkFunCall(expp) - register struct node *expp; + register t_node *expp; { /* Check a call that must have a result */ @@ -642,13 +660,13 @@ ChkFunCall(expp) int ChkCall(expp) - register struct node *expp; + register t_node *expp; { /* Check something that looks like a procedure or function call. Of course this does not have to be a call at all, it may also be a cast or a standard procedure call. */ - register struct node *left = expp->nd_left; + register t_node *left = expp->nd_left; STATIC int ChkStandard(); STATIC int ChkCast(); @@ -683,9 +701,9 @@ ChkCall(expp) return ChkProcCall(expp); } -STATIC struct type * +STATIC t_type * ResultOfOperation(operator, tp) - struct type *tp; + t_type *tp; { /* Return the result type of the binary operation "operator", with operand type "tp". @@ -744,7 +762,7 @@ AllowedTypes(operator) STATIC int ChkAddress(tpl, tpr) - register struct type *tpl, *tpr; + register t_type *tpl, *tpr; { /* Check that either "tpl" or "tpr" are both of type address_type, or that one of them is, but the other is @@ -764,12 +782,12 @@ ChkAddress(tpl, tpr) STATIC int ChkBinOper(expp) - register struct node *expp; + register t_node *expp; { /* Check a binary operation. */ - register struct node *left, *right; - register struct type *tpl, *tpr; + register t_node *left, *right; + register t_type *tpl, *tpr; int allowed; int retval; @@ -873,12 +891,12 @@ ChkBinOper(expp) STATIC int ChkUnOper(expp) - register struct node *expp; + register t_node *expp; { /* Check an unary operation. */ - register struct node *right = expp->nd_right; - register struct type *tpr; + register t_node *right = expp->nd_right; + register t_type *tpr; if (expp->nd_symb == '(') { *expp = *right; @@ -896,7 +914,9 @@ ChkUnOper(expp) switch(expp->nd_symb) { case '+': if (!(tpr->tp_fund & T_NUMERIC)) break; - /* fall through */ + *expp = *right; + free_node(right); + return 1; case '-': if (tpr->tp_fund & T_INTORCARD) { @@ -935,15 +955,15 @@ ChkUnOper(expp) return 0; } -STATIC struct node * +STATIC t_node * getvariable(argp, edf) - struct node **argp; - struct def *edf; + t_node **argp; + t_def *edf; { /* Get the next argument from argument list "argp". It must obey the rules of "ChkVariable". */ - register struct node *left = nextarg(argp, edf); + register t_node *left = nextarg(argp, edf); if (!left || !ChkVariable(left)) return 0; @@ -952,14 +972,14 @@ getvariable(argp, edf) STATIC int ChkStandard(expp) - register struct node *expp; + register t_node *expp; { /* Check a call of a standard procedure or function */ - struct node *arg = expp; - register struct node *left = expp->nd_left; - register struct def *edf = left->nd_def; - struct type *basetype; + t_node *arg = expp; + register t_node *left = expp->nd_left; + register t_def *edf = left->nd_def; + t_type *basetype; int free_it = 0; assert(left->nd_class == Def); @@ -1010,8 +1030,8 @@ ChkStandard(expp) case S_SHORT: case S_LONG: { - struct type *tp; - struct type *s1, *s2, *d1, *d2; + t_type *tp; + t_type *s1, *s2, *d1, *d2; if (edf->df_value.df_stdname == S_SHORT) { s1 = longint_type; @@ -1037,7 +1057,7 @@ ChkStandard(expp) MkCoercion(&(arg->nd_left), d2); } else { - Xerror(left, "unexpected parameter type", edf); + df_error(left, "unexpected parameter type", edf); break; } free_it = 1; @@ -1056,7 +1076,7 @@ ChkStandard(expp) break; } if (left->nd_symb != STRING) { - return Xerror(left,"array parameter expected", edf); + return df_error(left,"array parameter expected", edf); } expp->nd_type = card_type; expp->nd_class = Value; @@ -1105,12 +1125,12 @@ ChkStandard(expp) expp->nd_type = 0; if (! (left = getvariable(&arg, edf))) return 0; if (! (left->nd_type->tp_fund == T_POINTER)) { - return Xerror(left, "pointer variable expected", edf); + return df_error(left, "pointer variable expected", edf); } /* Now, make it look like a call to ALLOCATE or DEALLOCATE */ { - struct token dt; - struct node *nd; + t_token dt; + t_node *nd; dt.TOK_INT = PointedtoType(left->nd_type)->tp_size; dt.tk_symb = INTEGER; @@ -1121,9 +1141,9 @@ ChkStandard(expp) arg->nd_right = MkNode(Link, nd, NULLNODE, &dt); /* Ignore other arguments to NEW and/or DISPOSE ??? */ - FreeNode(expp->nd_left); dt.tk_symb = IDENT; dt.tk_lineno = expp->nd_left->nd_lineno; + FreeNode(expp->nd_left); dt.TOK_IDF = str2idf(edf->df_value.df_stdname==S_NEW ? "ALLOCATE" : "DEALLOCATE", 0); expp->nd_left = MkLeaf(Name, &dt); @@ -1178,7 +1198,7 @@ ChkStandard(expp) expp->nd_type = 0; if (! (left = getvariable(&arg, edf))) return 0; if (! (left->nd_type->tp_fund & T_DISCRETE)) { - return Xerror(left,"illegal parameter type", edf); + return df_error(left,"illegal parameter type", edf); } if (arg->nd_right) { if (! getarg(&arg, T_INTORCARD, 0, edf)) return 0; @@ -1192,14 +1212,14 @@ ChkStandard(expp) case S_EXCL: case S_INCL: { - register struct type *tp; - struct node *dummy; + register t_type *tp; + t_node *dummy; expp->nd_type = 0; if (!(left = getvariable(&arg, edf))) return 0; tp = left->nd_type; if (tp->tp_fund != T_SET) { - return Xerror(arg, "SET parameter expected", edf); + return df_error(arg, "SET parameter expected", edf); } if (!(dummy = getarg(&arg, 0, 0, edf))) return 0; if (!ChkAssCompat(&dummy, ElementType(tp), "EXCL/INCL")) { @@ -1220,7 +1240,7 @@ ChkStandard(expp) } if (arg->nd_right) { - return Xerror(arg->nd_right, "too many parameters supplied", edf); + return df_error(arg->nd_right, "too many parameters supplied", edf); } if (free_it) { @@ -1235,7 +1255,7 @@ ChkStandard(expp) STATIC int ChkCast(expp) - register struct node *expp; + register t_node *expp; { /* Check a cast and perform it if the argument is constant. If the sizes don't match, only complain if at least one of them @@ -1244,12 +1264,12 @@ ChkCast(expp) is no problem as such values take a word on the EM stack anyway. */ - register struct node *left = expp->nd_left; - register struct node *arg = expp->nd_right; - register struct type *lefttype = left->nd_type; + register t_node *left = expp->nd_left; + register t_node *arg = expp->nd_right; + register t_type *lefttype = left->nd_type; if ((! arg) || arg->nd_right) { - return Xerror(expp, "type cast must have 1 parameter", left->nd_def); + return df_error(expp, "type cast must have 1 parameter", left->nd_def); } if (! ChkExpression(arg->nd_left)) return 0; @@ -1260,7 +1280,7 @@ ChkCast(expp) if (arg->nd_type->tp_size != lefttype->tp_size && (arg->nd_type->tp_size > word_size || lefttype->tp_size > word_size)) { - Xerror(expp, "unequal sizes in type cast", left->nd_def); + df_error(expp, "unequal sizes in type cast", left->nd_def); } if (arg->nd_class == Value) { @@ -1275,8 +1295,8 @@ ChkCast(expp) } TryToString(nd, tp) - register struct node *nd; - struct type *tp; + register t_node *nd; + t_type *tp; { /* Try a coercion from character constant to string. */ @@ -1296,7 +1316,7 @@ TryToString(nd, tp) STATIC int no_desig(expp) - struct node *expp; + t_node *expp; { node_error(expp, "designator expected"); return 0; diff --git a/lang/m2/comp/chk_expr.h b/lang/m2/comp/chk_expr.h index 6ad8ca344..e45cdacc9 100644 --- a/lang/m2/comp/chk_expr.h +++ b/lang/m2/comp/chk_expr.h @@ -18,3 +18,6 @@ extern int (*DesigChkTable[])(); /* table of designator checking #define ChkExpression(expp) ((*ExprChkTable[(expp)->nd_class])(expp)) #define ChkDesignator(expp) ((*DesigChkTable[(expp)->nd_class])(expp)) + +#define inc_refcount(s) (*((s) - 1) += 1) +#define refcount(s) (*((s) - 1)) diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c index 81113271f..f70e4d95c 100644 --- a/lang/m2/comp/code.c +++ b/lang/m2/comp/code.c @@ -21,6 +21,7 @@ #include #include +#include "squeeze.h" #include "type.h" #include "LLlex.h" #include "def.h" @@ -39,7 +40,7 @@ int fp_used; STATIC char * NameOfProc(df) - register struct def *df; + register t_def *df; { assert(df->df_kind & (D_PROCHEAD|D_PROCEDURE)); @@ -68,14 +69,14 @@ CodeConst(cst, size) /* C_df_dlb(++data_label); C_rom_icon(long2str((long) cst), (arith) size); - C_lae_dlb(data_label, (arith) 0); + c_lae_dlb(data_label); C_loi((arith) size); */ } } CodeString(nd) - register struct node *nd; + register t_node *nd; { if (nd->nd_type->tp_fund != T_STRING) { /* Character constant */ @@ -84,15 +85,15 @@ CodeString(nd) } C_df_dlb(++data_label); C_rom_scon(nd->nd_STR, WA(nd->nd_SLE + 1)); - C_lae_dlb(data_label, (arith) 0); + c_lae_dlb(data_label); } CodeExpr(nd, ds, true_label, false_label) - register struct node *nd; - register struct desig *ds; + register t_node *nd; + register t_desig *ds; label true_label, false_label; { - register struct type *tp = nd->nd_type; + register t_type *tp = nd->nd_type; if (tp->tp_fund == T_REAL) fp_used = 1; switch(nd->nd_class) { @@ -126,7 +127,7 @@ CodeExpr(nd, ds, true_label, false_label) case REAL: C_df_dlb(++data_label); C_rom_fcon(nd->nd_REL, tp->tp_size); - C_lae_dlb(data_label, (arith) 0); + c_lae_dlb(data_label); C_loi(tp->tp_size); break; case STRING: @@ -154,8 +155,7 @@ CodeExpr(nd, ds, true_label, false_label) for (; i; i--) { C_loc(*--st); } - free((char *) nd->nd_set); - nd->nd_set = 0; + FreeSet(nd->nd_set); CodeSet(nd); } break; @@ -174,7 +174,7 @@ CodeExpr(nd, ds, true_label, false_label) } CodeCoercion(t1, t2) - register struct type *t1, *t2; + register t_type *t1, *t2; { register int fund1, fund2; arith sz1 = t1->tp_size; @@ -208,7 +208,7 @@ CodeCoercion(t1, t2) case T_INTEGER: if (sz1 < word_size) { C_loc(sz1); - C_loc(word_size); + c_loc((int) word_size); C_cii(); } switch(fund2) { @@ -222,7 +222,7 @@ CodeCoercion(t1, t2) case T_CARDINAL: if (t1->tp_size != word_size) { C_loc(t1->tp_size); - C_loc(word_size); + c_loc((int) word_size); C_ciu(); } break; @@ -242,20 +242,20 @@ CodeCoercion(t1, t2) case T_CARDINAL: case T_INTORCARD: if (t2->tp_size > word_size) { - C_loc(word_size); + c_loc((int) word_size); C_loc(t2->tp_size); C_cuu(); } break; case T_INTEGER: if (fund1 == T_CARDINAL || t2->tp_size != word_size) { - C_loc(word_size); + c_loc((int) word_size); C_loc(t2->tp_size); C_cui(); } break; case T_REAL: - C_loc(word_size); + c_loc((int) word_size); C_loc(t2->tp_size); C_cuf(); break; @@ -286,7 +286,7 @@ CodeCoercion(t1, t2) C_zrf(t1->tp_size); C_cmf(t1->tp_size); C_zge(lb); - C_loc((arith) ECONV); + c_loc(ECONV); C_trp(); C_df_ilb(lb); } @@ -302,14 +302,14 @@ CodeCoercion(t1, t2) } CodeCall(nd) - register struct node *nd; + register t_node *nd; { /* Generate code for a procedure call. Checking of parameters and result is already done. */ - register struct node *left = nd->nd_left; - register struct node *right = nd->nd_right; - register struct type *result_tp; + register t_node *left = nd->nd_left; + register t_node *right = nd->nd_right; + register t_type *result_tp; if (left->nd_type == std_type) { CodeStd(nd); @@ -360,11 +360,11 @@ CodeCall(nd) CodeParameters(param, arg) struct paramlist *param; - struct node *arg; + t_node *arg; { - register struct type *tp; - register struct node *left; - register struct type *left_type; + register t_type *tp; + register t_node *left; + register t_type *left_type; assert(param != 0 && arg != 0); @@ -376,7 +376,7 @@ CodeParameters(param, arg) left = arg->nd_left; left_type = left->nd_type; if (IsConformantArray(tp)) { - register struct type *elem = tp->arr_elem; + register t_type *elem = tp->arr_elem; C_loc(tp->arr_elsize); if (IsConformantArray(left_type)) { @@ -388,9 +388,9 @@ CodeParameters(param, arg) C_loc(left_type->arr_elem->tp_size); C_mli(word_size); if (elem == word_type) { - C_loc(word_size - 1); + c_loc((int) word_size - 1); C_adi(word_size); - C_loc(word_size); + c_loc((int) word_size); C_dvi(word_size); } else { @@ -412,7 +412,7 @@ CodeParameters(param, arg) getbounds(IndexType(left_type), &lb, &ub); C_loc(ub - lb); } - C_loc((arith) 0); + c_loc(0); if (left->nd_symb == STRING) { CodeString(left); } @@ -447,8 +447,8 @@ CodeParameters(param, arg) } CodePString(nd, tp) - struct node *nd; - struct type *tp; + t_node *nd; + t_type *tp; { arith szarg = WA(nd->nd_type->tp_size); register arith zersz = WA(tp->tp_size) - szarg; @@ -463,11 +463,11 @@ CodePString(nd, tp) } CodeStd(nd) - struct node *nd; + t_node *nd; { - register struct node *arg = nd->nd_right; - register struct node *left = 0; - register struct type *tp; + register t_node *arg = nd->nd_right; + register t_node *left = 0; + register t_type *tp; int std = nd->nd_left->nd_def->df_value.df_stdname; if (arg) { @@ -493,7 +493,7 @@ CodeStd(nd) case S_CAP: CodePExpr(left); - C_loc((arith) 0137); /* ASCII assumed */ + c_loc(0137); /* ASCII assumed */ C_and(word_size); break; @@ -514,7 +514,7 @@ CodeStd(nd) case S_ODD: CodePExpr(left); if (tp->tp_size == word_size) { - C_loc((arith) 1); + c_loc(1); C_and(word_size); } else { @@ -541,7 +541,7 @@ CodeStd(nd) CodeCoercion(arg->nd_left->nd_type, tp); } else { - C_loc((arith) 1); + c_loc(1); CodeCoercion(intorcard_type, tp); } if (std == S_DEC) { @@ -585,7 +585,7 @@ CodeStd(nd) } RangeCheck(tpl, tpr) - register struct type *tpl, *tpr; + register t_type *tpl, *tpr; { /* Generate a range check if neccessary */ @@ -621,14 +621,14 @@ RangeCheck(tpl, tpr) C_dup(word_size); C_zge(lb); - C_loc((arith) ECONV); + c_loc(ECONV); C_trp(); C_df_ilb(lb); } } Operands(leftop, rightop) - register struct node *leftop, *rightop; + register t_node *leftop, *rightop; { CodePExpr(leftop); @@ -636,13 +636,13 @@ Operands(leftop, rightop) } CodeOper(expr, true_label, false_label) - register struct node *expr; /* the expression tree itself */ + register t_node *expr; /* the expression tree itself */ label true_label; label false_label; /* labels to jump to in logical expr's */ { - register struct node *leftop = expr->nd_left; - register struct node *rightop = expr->nd_right; - register struct type *tp = expr->nd_type; + register t_node *leftop = expr->nd_left; + register t_node *rightop = expr->nd_right; + register t_type *tp = expr->nd_type; switch (expr->nd_symb) { case '+': @@ -830,7 +830,7 @@ CodeOper(expr, true_label, false_label) case OR: case AND: { label l_maybe = ++text_label, l_end; - struct desig *Des = new_desig(); + t_desig *Des = new_desig(); int genlabels = 0; if (true_label == NO_LABEL) { @@ -850,10 +850,10 @@ CodeOper(expr, true_label, false_label) CodeExpr(rightop, Des, true_label, false_label); if (genlabels) { C_df_ilb(true_label); - C_loc((arith)1); + c_loc(1); C_bra(l_end); C_df_ilb(false_label); - C_loc((arith)0); + c_loc(0); C_df_ilb(l_end); } free_desig(Des); @@ -922,9 +922,9 @@ truthvalue(relop) } CodeUoper(nd) - register struct node *nd; + register t_node *nd; { - register struct type *tp = nd->nd_type; + register t_type *tp = nd->nd_type; CodePExpr(nd->nd_right); switch(nd->nd_symb) { @@ -954,9 +954,9 @@ CodeUoper(nd) } CodeSet(nd) - register struct node *nd; + register t_node *nd; { - register struct type *tp = nd->nd_type; + register t_type *tp = nd->nd_type; nd = nd->nd_right; while (nd) { @@ -968,10 +968,10 @@ CodeSet(nd) } CodeEl(nd, tp) - register struct node *nd; - register struct type *tp; + register t_node *nd; + register t_type *tp; { - register struct type *eltype = ElementType(tp); + register t_type *eltype = ElementType(tp); if (nd->nd_class == Link && nd->nd_symb == UPTO) { C_loc(tp->tp_size); /* push size */ @@ -991,12 +991,12 @@ CodeEl(nd, tp) } CodePExpr(nd) - register struct node *nd; + register t_node *nd; { /* Generate code to push the value of the expression "nd" on the stack. */ - register struct desig *designator = new_desig(); + register t_desig *designator = new_desig(); CodeExpr(nd, designator, NO_LABEL, NO_LABEL); CodeValue(designator, nd->nd_type); @@ -1004,13 +1004,13 @@ CodePExpr(nd) } CodeDAddress(nd) - struct node *nd; + t_node *nd; { /* Generate code to push the address of the designator "nd" on the stack. */ - register struct desig *designator = new_desig(); + register t_desig *designator = new_desig(); ChkForFOR(nd); CodeDesig(nd, designator); @@ -1019,13 +1019,13 @@ CodeDAddress(nd) } CodeDStore(nd) - register struct node *nd; + register t_node *nd; { /* Generate code to store the expression on the stack into the designator "nd". */ - register struct desig *designator = new_desig(); + register t_desig *designator = new_desig(); ChkForFOR(nd); CodeDesig(nd, designator); @@ -1034,7 +1034,7 @@ CodeDStore(nd) } DoHIGH(df) - register struct def *df; + register t_def *df; { /* Get the high index of a conformant array, indicated by "nd". The high index is the second field in the descriptor of @@ -1055,3 +1055,16 @@ DoHIGH(df) } else C_lol(highoff); } + +#ifdef SQUEEZE +c_loc(n) +{ + C_loc((arith) n); +} + +c_lae_dlb(l) + label l; +{ + C_lae_dlb(l, (arith) 0); +} +#endif diff --git a/lang/m2/comp/cstoper.c b/lang/m2/comp/cstoper.c index 55ba64821..01bb9299e 100644 --- a/lang/m2/comp/cstoper.c +++ b/lang/m2/comp/cstoper.c @@ -38,12 +38,12 @@ extern char options[]; static char ovflow[] = "overflow in constant expression"; cstunary(expp) - register struct node *expp; + register t_node *expp; { /* The unary operation in "expp" is performed on the constant expression below it, and the result restored in expp. */ - register struct node *right = expp->nd_right; + register t_node *right = expp->nd_right; switch(expp->nd_symb) { /* Should not get here @@ -75,7 +75,7 @@ cstunary(expp) } cstbin(expp) - register struct node *expp; + register t_node *expp; { /* The binary operation in "expp" is performed on the constant expressions below it, and the result restored in @@ -236,10 +236,11 @@ cstbin(expp) } cstset(expp) - register struct node *expp; + register t_node *expp; { + extern arith *MkSet(); register arith *set1, *set2; - arith *resultset = 0; + register arith *resultset; register unsigned int setsize; register int j; @@ -259,114 +260,90 @@ cstset(expp) expp->nd_INT = (expp->nd_left->nd_INT >= 0 && expp->nd_left->nd_INT < setsize * wrd_bits && (set2[i / wrd_bits] & (1 << (i % wrd_bits)))); - free((char *) set2); + FreeSet(set2); expp->nd_symb = INTEGER; - } - else { - set1 = expp->nd_left->nd_set; - resultset = set1; - expp->nd_left->nd_set = 0; - switch(expp->nd_symb) { - case '+': - /* Set union - */ - for (j = 0; j < setsize; j++) { - *set1++ |= *set2++; - } - break; - - case '-': - /* Set difference - */ - for (j = 0; j < setsize; j++) { - *set1++ &= ~*set2++; - } - break; - - case '*': - /* Set intersection - */ - for (j = 0; j < setsize; j++) { - *set1++ &= *set2++; - } - break; - - case '/': - /* Symmetric set difference - */ - for (j = 0; j < setsize; j++) { - *set1++ ^= *set2++; - } - break; - - case GREATEREQUAL: - case LESSEQUAL: - case '=': - case '#': - /* Constant set comparisons - */ - expp->nd_left->nd_set = set1; /* may be disposed of */ - for (j = 0; j < setsize; j++) { - switch(expp->nd_symb) { - case GREATEREQUAL: - if ((*set1 | *set2++) != *set1) break; - set1++; - continue; - case LESSEQUAL: - if ((*set2 | *set1++) != *set2) break; - set2++; - continue; - case '=': - case '#': - if (*set1++ != *set2++) break; - continue; - } - break; - } - if (j < setsize) { - expp->nd_INT = expp->nd_symb == '#'; - } - else { - expp->nd_INT = expp->nd_symb != '#'; - } - expp->nd_class = Value; - expp->nd_symb = INTEGER; - freesets(expp); - return; - default: - crash("(cstset)"); - } - freesets(expp); - expp->nd_class = Set; - expp->nd_set = resultset; + FreeNode(expp->nd_left); + FreeNode(expp->nd_right); + expp->nd_left = expp->nd_right = 0; return; } - FreeNode(expp->nd_left); - FreeNode(expp->nd_right); - expp->nd_left = expp->nd_right = 0; -} -freesets(expp) - register struct node *expp; -{ - if (expp->nd_right->nd_set) { - free((char *) expp->nd_right->nd_set); - } - if (expp->nd_left->nd_set) { - free((char *) expp->nd_left->nd_set); + set1 = expp->nd_left->nd_set; + switch(expp->nd_symb) { + case '+': /* Set union */ + case '-': /* Set difference */ + case '*': /* Set intersection */ + case '/': /* Symmetric set difference */ + expp->nd_set = resultset = MkSet(setsize * (unsigned) word_size); + for (j = 0; j < setsize; j++) { + switch(expp->nd_symb) { + case '+': + *resultset = *set1++ | *set2++; + break; + case '-': + *resultset = *set1++ & ~*set2++; + break; + case '*': + *resultset = *set1++ & *set2++; + break; + case '/': + *resultset = *set1++ ^ *set2++; + break; + } + resultset++; + } + expp->nd_class = Set; + break; + + case GREATEREQUAL: + case LESSEQUAL: + case '=': + case '#': + /* Constant set comparisons + */ + for (j = 0; j < setsize; j++) { + switch(expp->nd_symb) { + case GREATEREQUAL: + if ((*set1 | *set2++) != *set1) break; + set1++; + continue; + case LESSEQUAL: + if ((*set2 | *set1++) != *set2) break; + set2++; + continue; + case '=': + case '#': + if (*set1++ != *set2++) break; + continue; + } + break; + } + if (j < setsize) { + expp->nd_INT = expp->nd_symb == '#'; + } + else { + expp->nd_INT = expp->nd_symb != '#'; + } + expp->nd_class = Value; + expp->nd_symb = INTEGER; + break; + default: + crash("(cstset)"); } + FreeSet(expp->nd_left->nd_set); + FreeSet(expp->nd_right->nd_set); FreeNode(expp->nd_left); FreeNode(expp->nd_right); expp->nd_left = expp->nd_right = 0; } cstcall(expp, call) - register struct node *expp; + register t_node *expp; { /* a standard procedure call is found that can be evaluated compile time, so do so. */ - register struct node *expr = 0; + register t_node *expr = 0; assert(expp->nd_class == Call); @@ -440,13 +417,13 @@ cstcall(expp, call) } CutSize(expr) - register struct node *expr; + register t_node *expr; { /* The constant value of the expression expr is made to conform to the size of the type of the expression. */ register arith o1 = expr->nd_INT; - register struct type *tp = BaseType(expr->nd_type); + register t_type *tp = BaseType(expr->nd_type); int uns; int size = tp->tp_size; diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g index 46148b3d7..8d76e3c26 100644 --- a/lang/m2/comp/declar.g +++ b/lang/m2/comp/declar.g @@ -32,13 +32,13 @@ int proclevel = 0; /* nesting level of procedures */ int return_occurred; /* set if a return occurs in a block */ #define needs_static_link() (proclevel > 1) -extern struct node *EmptyStatement; +extern t_node *EmptyStatement; } /* inline in declaration: need space ProcedureDeclaration { - struct def *df; + t_def *df; } : { ++proclevel; } ProcedureHeading(&df, D_PROCEDURE) @@ -50,9 +50,9 @@ ProcedureDeclaration ; */ -ProcedureHeading(struct def **pdf; int type;) +ProcedureHeading(t_def **pdf; int type;) { - struct type *tp = 0; + t_type *tp = 0; arith parmaddr = needs_static_link() ? pointer_size : 0; struct paramlist *pr = 0; } : @@ -78,7 +78,7 @@ warning(W_STRICT, "procedure \"%s\" has a constructed result type", } ; -block(struct node **pnd;) : +block(t_node **pnd;) : [ %persistent declaration ]* @@ -94,7 +94,7 @@ block(struct node **pnd;) : declaration { - struct def *df; + t_def *df; } : CONST [ ConstantDeclaration ';' ]* | @@ -116,7 +116,7 @@ declaration ; /* inline in procedureheading: need space -FormalParameters(struct paramlist **ppr; arith *parmaddr; struct type **ptp;): +FormalParameters(struct paramlist **ppr; arith *parmaddr; t_type **ptp;): '(' [ FPSection(ppr, parmaddr) @@ -132,15 +132,15 @@ FormalParameters(struct paramlist **ppr; arith *parmaddr; struct type **ptp;): FPSection(struct paramlist **ppr; arith *parmaddr;) { - struct node *FPList; - struct type *tp; + t_node *FPList; + t_type *tp; int VARp; } : var(&VARp) IdentList(&FPList) ':' FormalType(&tp) { EnterParamList(ppr, FPList, tp, VARp, parmaddr); } ; -FormalType(struct type **ptp;) +FormalType(t_type **ptp;) { extern arith ArrayElSize(); } : @@ -148,7 +148,7 @@ FormalType(struct type **ptp;) { /* index type of conformant array is "CARDINAL". Recognize a conformant array by size 0. */ - register struct type *tp = construct_type(T_ARRAY, card_type); + register t_type *tp = construct_type(T_ARRAY, card_type); tp->arr_elem = *ptp; *ptp = tp; @@ -161,20 +161,20 @@ FormalType(struct type **ptp;) TypeDeclaration { - struct def *df; - struct type *tp; - register struct node *nd; + t_def *df; + t_type *tp; + register t_node *nd; }: IDENT { df = define(dot.TOK_IDF, CurrentScope, D_TYPE); nd = dot2leaf(Name); } '=' type(&tp) { DeclareType(nd, df, tp); - free_node(nd); + FreeNode(nd); } ; -type(register struct type **ptp;): +type(register t_type **ptp;): %default SimpleType(ptp) | ArrayType(ptp) @@ -188,9 +188,9 @@ type(register struct type **ptp;): ProcedureType(ptp) ; -SimpleType(register struct type **ptp;) +SimpleType(register t_type **ptp;) { - struct type *tp; + t_type *tp; } : qualtype(ptp) [ @@ -208,17 +208,17 @@ SimpleType(register struct type **ptp;) SubrangeType(ptp) ; -enumeration(struct type **ptp;) +enumeration(t_type **ptp;) { - struct node *EnumList; + t_node *EnumList; } : '(' IdentList(&EnumList) ')' { *ptp = enum_type(EnumList); } ; -IdentList(struct node **p;) +IdentList(t_node **p;) { - register struct node *q; + register t_node *q; } : IDENT { *p = q = dot2leaf(Value); } [ %persistent @@ -230,9 +230,9 @@ IdentList(struct node **p;) { q->nd_left = 0; } ; -SubrangeType(struct type **ptp;) +SubrangeType(t_type **ptp;) { - struct node *nd1, *nd2; + t_node *nd1, *nd2; }: /* This is not exactly the rule in the new report, but see @@ -242,15 +242,15 @@ SubrangeType(struct type **ptp;) UPTO ConstExpression(&nd2) ']' { *ptp = subr_type(nd1, nd2); - free_node(nd1); - free_node(nd2); + FreeNode(nd1); + FreeNode(nd2); } ; -ArrayType(struct type **ptp;) +ArrayType(t_type **ptp;) { - struct type *tp; - register struct type *tp2; + t_type *tp; + register t_type *tp2; } : ARRAY SimpleType(&tp) { *ptp = tp2 = construct_type(T_ARRAY, tp); } @@ -265,7 +265,7 @@ ArrayType(struct type **ptp;) } ; -RecordType(struct type **ptp;) +RecordType(t_type **ptp;) { register struct scope *scope; arith size = 0; @@ -294,10 +294,10 @@ FieldListSequence(struct scope *scope; arith *cnt; int *palign;): FieldList(struct scope *scope; arith *cnt; int *palign;) { - struct node *FldList; - struct type *tp; - struct node *nd; - register struct def *df; + t_node *FldList; + t_type *tp; + t_node *nd; + register t_def *df; arith tcnt, max; } : [ @@ -358,9 +358,9 @@ FieldList(struct scope *scope; arith *cnt; int *palign;) ]? ; -variant(struct scope *scope; arith *cnt; struct type *tp; int *palign;) +variant(struct scope *scope; arith *cnt; t_type *tp; int *palign;) { - struct node *nd; + t_node *nd; } : [ CaseLabelList(&tp, &nd) @@ -375,7 +375,7 @@ variant(struct scope *scope; arith *cnt; struct type *tp; int *palign;) /* Changed rule in new modula-2 */ ; -CaseLabelList(struct type **ptp; struct node **pnd;): +CaseLabelList(t_type **ptp; t_node **pnd;): CaseLabels(ptp, pnd) [ { *pnd = dot2node(Link, *pnd, NULLNODE); } @@ -384,9 +384,9 @@ CaseLabelList(struct type **ptp; struct node **pnd;): ]* ; -CaseLabels(struct type **ptp; register struct node **pnd;) +CaseLabels(t_type **ptp; register t_node **pnd;) { - register struct node *nd; + register t_node *nd; }: ConstExpression(pnd) { @@ -409,7 +409,7 @@ CaseLabels(struct type **ptp; register struct node **pnd;) } ; -SetType(struct type **ptp;) : +SetType(t_type **ptp;) : SET OF SimpleType(ptp) { *ptp = set_type(*ptp); } ; @@ -418,7 +418,7 @@ SetType(struct type **ptp;) : have to be declared yet, so be careful about identifying type-identifiers */ -PointerType(register struct type **ptp;) : +PointerType(register t_type **ptp;) : { *ptp = construct_type(T_POINTER, NULLTYPE); } POINTER TO [ %if (type_or_forward(ptp)) @@ -428,27 +428,27 @@ PointerType(register struct type **ptp;) : ] ; -qualtype(struct type **ptp;) +qualtype(t_type **ptp;) { - struct node *nd; + t_node *nd; } : qualident(&nd) { *ptp = qualified_type(nd); } ; -ProcedureType(struct type **ptp;) : +ProcedureType(t_type **ptp;) : PROCEDURE [ FormalTypeList(ptp) | - { *ptp = proc_type((struct type *) 0, + { *ptp = proc_type((t_type *) 0, (struct paramlist *) 0, (arith) 0); } ] ; -FormalTypeList(struct type **ptp;) +FormalTypeList(t_type **ptp;) { struct paramlist *pr = 0; arith parmaddr = 0; @@ -469,7 +469,7 @@ FormalTypeList(struct type **ptp;) VarFormalType(struct paramlist **ppr; arith *parmaddr;) { - struct type *tp; + t_type *tp; int isvar; } : var(&isvar) @@ -487,9 +487,9 @@ var(int *VARp;) : ConstantDeclaration { - struct idf *id; - struct node *nd; - register struct def *df; + t_idf *id; + t_node *nd; + register t_def *df; }: IDENT { id = dot.TOK_IDF; } '=' ConstExpression(&nd) @@ -502,9 +502,9 @@ ConstantDeclaration VariableDeclaration { - struct node *VarList; - register struct node *nd; - struct type *tp; + t_node *VarList; + register t_node *nd; + t_type *tp; } : IdentAddr(&VarList) { nd = VarList; } @@ -516,9 +516,9 @@ VariableDeclaration { EnterVarList(VarList, tp, proclevel > 0); } ; -IdentAddr(struct node **pnd;) +IdentAddr(t_node **pnd;) { - register struct node *nd; + register t_node *nd; } : IDENT { nd = dot2leaf(Name); } [ '[' diff --git a/lang/m2/comp/def.H b/lang/m2/comp/def.H index ebedc9736..561f1ac8f 100644 --- a/lang/m2/comp/def.H +++ b/lang/m2/comp/def.H @@ -128,15 +128,15 @@ struct def { /* list of definitions for a name */ } df_value; }; +typedef struct def t_def; /* ALLOCDEF "def" 50 */ -extern struct def +extern t_def *define(), *DefineLocalModule(), *MkDef(), - *DeclProc(); - -extern struct def + *DeclProc(), *lookup(), *lookfor(); -#define NULLDEF ((struct def *) 0) + +#define NULLDEF ((t_def *) 0) diff --git a/lang/m2/comp/def.c b/lang/m2/comp/def.c index ca11c871e..b5d532c83 100644 --- a/lang/m2/comp/def.c +++ b/lang/m2/comp/def.c @@ -27,14 +27,14 @@ STATIC DefInFront(df) - register struct def *df; + register t_def *df; { /* Put definition "df" in front of the list of definitions in its scope. This is neccessary because in some cases the order in this list is important. */ - register struct def *df1 = df->df_scope->sc_def; + register t_def *df1 = df->df_scope->sc_def; if (df1 != df) { /* Definition "df" is not in front of the list @@ -58,15 +58,15 @@ DefInFront(df) } } -struct def * +t_def * MkDef(id, scope, kind) - register struct idf *id; + register t_idf *id; register struct scope *scope; { /* Create a new definition structure in scope "scope", with id "id" and kind "kind". */ - register struct def *df; + register t_def *df; df = new_def(); df->df_idf = id; @@ -82,9 +82,9 @@ MkDef(id, scope, kind) return df; } -struct def * +t_def * define(id, scope, kind) - register struct idf *id; + register t_idf *id; register struct scope *scope; int kind; { @@ -93,7 +93,7 @@ define(id, scope, kind) If so, then check for the cases in which this is legal, and otherwise give an error message. */ - register struct def *df; + register t_def *df; df = lookup(id, scope, 1); if ( /* Already in this scope */ @@ -180,13 +180,13 @@ define(id, scope, kind) } RemoveImports(pdf) - register struct def **pdf; + register t_def **pdf; { /* Remove all imports from a definition module. This is neccesary because the implementation module might import them again. */ - register struct def *df = *pdf; + register t_def *df = *pdf; while (df) { if (df->df_kind == D_IMPORT) { @@ -202,12 +202,12 @@ RemoveImports(pdf) } RemoveFromIdList(df) - register struct def *df; + register t_def *df; { /* Remove definition "df" from the definition list */ - register struct idf *id = df->df_idf; - register struct def *df1; + register t_idf *id = df->df_idf; + register t_def *df1; if ((df1 = id->id_def) == df) id->id_def = df->df_next; else { @@ -219,15 +219,15 @@ RemoveFromIdList(df) } } -struct def * +t_def * DeclProc(type, id) - register struct idf *id; + register t_idf *id; { /* A procedure is declared, either in a definition or a program module. Create a def structure for it (if neccessary). Also create a name for it. */ - register struct def *df; + register t_def *df; register struct scope *scope; extern char *sprint(); static int nmcount; @@ -286,8 +286,8 @@ DeclProc(type, id) } EndProc(df, id) - register struct def *df; - struct idf *id; + register t_def *df; + t_idf *id; { /* The end of a procedure declaration. Check that the closing identifier matches the name of the @@ -304,14 +304,14 @@ EndProc(df, id) } } -struct def * +t_def * DefineLocalModule(id) - struct idf *id; + t_idf *id; { /* Create a definition for a local module. Also give it a name to be used for code generation. */ - register struct def *df = define(id, CurrentScope, D_MODULE); + register t_def *df = define(id, CurrentScope, D_MODULE); register struct scope *sc; static int modulecount = 0; char buf[256]; @@ -352,8 +352,8 @@ DefineLocalModule(id) } CheckWithDef(df, tp) - register struct def *df; - struct type *tp; + register t_def *df; + t_type *tp; { /* Check the header of a procedure declaration against a possible earlier definition in the definition module. @@ -374,7 +374,7 @@ CheckWithDef(df, tp) #ifdef DEBUG PrDef(df) - register struct def *df; + register t_def *df; { print("n: %s, k: %d\n", df->df_idf->id_text, df->df_kind); } diff --git a/lang/m2/comp/defmodule.c b/lang/m2/comp/defmodule.c index f624a6d35..7e505f53f 100644 --- a/lang/m2/comp/defmodule.c +++ b/lang/m2/comp/defmodule.c @@ -32,7 +32,7 @@ long sys_filesize(); #endif -struct idf *DefId; +t_idf *DefId; char * getwdir(fn) @@ -80,16 +80,16 @@ GetFile(name) return 1; } -struct def * +t_def * GetDefinitionModule(id, incr) - register struct idf *id; + register t_idf *id; { /* Return a pointer to the "def" structure of the definition module indicated by "id". We may have to read the definition module itself. Also increment level by "incr". */ - register struct def *df; + register t_def *df; static int level; struct scopelist *vis; char *fn = FileName; @@ -124,9 +124,9 @@ GetDefinitionModule(id, incr) remember its name because we have to call its initialization routine */ - static struct node *nd_end; - register struct node *n; - extern struct node *Modules; + static t_node *nd_end; + register t_node *n; + extern t_node *Modules; n = dot2leaf(Name); n->nd_IDF = id; diff --git a/lang/m2/comp/desig.H b/lang/m2/comp/desig.H index 52b252af4..b16355504 100644 --- a/lang/m2/comp/desig.H +++ b/lang/m2/comp/desig.H @@ -45,6 +45,8 @@ struct desig { */ }; +typedef struct desig t_desig; + /* ALLOCDEF "desig" 5 */ /* The next structure describes the designator in a with-statement. @@ -56,7 +58,7 @@ struct withdesig { struct scope *w_scope; /* scope in which fields of this record reside */ - struct desig w_desig; /* a desig structure for this particular + t_desig w_desig; /* a desig structure for this particular designator */ }; diff --git a/lang/m2/comp/desig.c b/lang/m2/comp/desig.c index 8c8f695e3..a908072aa 100644 --- a/lang/m2/comp/desig.c +++ b/lang/m2/comp/desig.c @@ -24,6 +24,7 @@ #include #include +#include "squeeze.h" #include "type.h" #include "LLlex.h" #include "def.h" @@ -31,65 +32,74 @@ #include "desig.h" #include "node.h" #include "warning.h" +#include "walk.h" extern int proclevel; int WordOrDouble(ds, size) - register struct desig *ds; + register t_desig *ds; arith size; { - return ((int) (ds->dsg_offset) % (int) word_size == 0 && - ( (int) size == (int) word_size || - (int) size == (int) dword_size)); + if ((int) (ds->dsg_offset) % (int) word_size == 0) { + if (size == word_size) return 1; + if (size == dword_size) return 2; + } + return 0; } int DoLoad(ds, size) - register struct desig *ds; + register t_desig *ds; arith size; { - if (! WordOrDouble(ds, size)) return 0; - if (ds->dsg_name) { - if ((int) size == (int) word_size) { + switch (WordOrDouble(ds, size)) { + default: + return 0; + case 1: + if (ds->dsg_name) { C_loe_dnam(ds->dsg_name, ds->dsg_offset); } - else C_lde_dnam(ds->dsg_name, ds->dsg_offset); - } - else { - if ((int) size == (int) word_size) { - C_lol(ds->dsg_offset); + else C_lol(ds->dsg_offset); + break; + case 2: + if (ds->dsg_name) { + C_lde_dnam(ds->dsg_name, ds->dsg_offset); } else C_ldl(ds->dsg_offset); + break; } return 1; } int DoStore(ds, size) - register struct desig *ds; + register t_desig *ds; arith size; { - if (! WordOrDouble(ds, size)) return 0; - if (ds->dsg_name) { - if ((int) size == (int) word_size) { + switch (WordOrDouble(ds, size)) { + default: + return 0; + case 1: + if (ds->dsg_name) { C_ste_dnam(ds->dsg_name, ds->dsg_offset); } - else C_sde_dnam(ds->dsg_name, ds->dsg_offset); - } - else { - if ((int) size == (int) word_size) { - C_stl(ds->dsg_offset); + else C_stl(ds->dsg_offset); + break; + case 2: + if (ds->dsg_name) { + C_sde_dnam(ds->dsg_name, ds->dsg_offset); } else C_sdl(ds->dsg_offset); + break; } return 1; } STATIC int properly(ds, tp) - register struct desig *ds; - register struct type *tp; + register t_desig *ds; + register t_type *tp; { /* Check if it is allowed to load or store the value indicated by "ds" with LOI/STI. @@ -115,8 +125,8 @@ properly(ds, tp) } CodeValue(ds, tp) - register struct desig *ds; - register struct type *tp; + register t_desig *ds; + register t_type *tp; { /* Generate code to load the value of the designator described in "ds" @@ -167,10 +177,10 @@ CodeValue(ds, tp) } ChkForFOR(nd) - struct node *nd; + t_node *nd; { if (nd->nd_class == Def) { - register struct def *df = nd->nd_def; + register t_def *df = nd->nd_def; if (df->df_flags & D_FORLOOP) { node_warning(nd, @@ -182,13 +192,13 @@ ChkForFOR(nd) } CodeStore(ds, tp) - register struct desig *ds; - register struct type *tp; + register t_desig *ds; + register t_type *tp; { /* Generate code to store the value on the stack in the designator described in "ds" */ - struct desig save; + t_desig save; save = *ds; @@ -220,10 +230,10 @@ CodeStore(ds, tp) } CodeCopy(lhs, rhs, sz, psize) - register struct desig *lhs, *rhs; + register t_desig *lhs, *rhs; arith sz, *psize; { - struct desig l, r; + t_desig l, r; l = *lhs; r = *rhs; *psize -= sz; @@ -236,12 +246,12 @@ CodeCopy(lhs, rhs, sz, psize) } CodeMove(rhs, left, rtp) - register struct desig *rhs; - register struct node *left; - struct type *rtp; + register t_desig *rhs; + register t_node *left; + t_type *rtp; { - register struct desig *lhs = new_desig(); - register struct type *tp = left->nd_type; + register t_desig *lhs = new_desig(); + register t_type *tp = left->nd_type; int loadedflag = 0; /* Generate code for an assignment. Testing of type @@ -297,7 +307,7 @@ CodeMove(rhs, left, rtp) if (size > 3*dword_size) { /* Do a block move */ - struct desig l, r; + t_desig l, r; arith sz; sz = (size / word_size) * word_size; @@ -365,7 +375,7 @@ CodeMove(rhs, left, rtp) } CodeAddress(ds) - register struct desig *ds; + register t_desig *ds; { /* Generate code to load the address of the designator described in "ds" @@ -404,8 +414,8 @@ CodeAddress(ds) } CodeFieldDesig(df, ds) - register struct def *df; - register struct desig *ds; + register t_def *df; + register t_desig *ds; { /* Generate code for a field designator. Only the code common for address as well as value computation is generated, and the @@ -455,8 +465,8 @@ CodeFieldDesig(df, ds) } CodeVarDesig(df, ds) - register struct def *df; - register struct desig *ds; + register t_def *df; + register t_desig *ds; { /* Generate code for a variable represented by a "def" structure. Of course, there are numerous cases: the variable is local, @@ -532,13 +542,13 @@ CodeVarDesig(df, ds) } CodeDesig(nd, ds) - register struct node *nd; - register struct desig *ds; + register t_node *nd; + register t_desig *ds; { /* Generate code for a designator. Use divide and conquer principle */ - register struct def *df; + register t_def *df; switch(nd->nd_class) { /* Divide */ case Def: @@ -579,7 +589,7 @@ CodeDesig(nd, ds) else C_lal(df->var_off + pointer_size); } else { - C_lae_dlb(nd->nd_left->nd_type->arr_descr, (arith) 0); + c_lae_dlb(nd->nd_left->nd_type->arr_descr); } ds->dsg_kind = DSG_INDEXED; break; diff --git a/lang/m2/comp/enter.c b/lang/m2/comp/enter.c index 27c2ffefa..0803a8c59 100644 --- a/lang/m2/comp/enter.c +++ b/lang/m2/comp/enter.c @@ -27,16 +27,16 @@ #include "misc.h" #include "f_info.h" -struct def * +t_def * Enter(name, kind, type, pnam) char *name; - struct type *type; + t_type *type; { /* Enter a definition for "name" with kind "kind" and type "type" in the Current Scope. If it is a standard name, also put its number in the definition structure. */ - register struct def *df; + register t_def *df; df = define(str2idf(name, 0), CurrentScope, kind); df->df_type = type; @@ -46,7 +46,7 @@ Enter(name, kind, type, pnam) EnterType(name, type) char *name; - struct type *type; + t_type *type; { /* Enter a type definition for "name" and type "type" in the Current Scope. @@ -56,8 +56,8 @@ EnterType(name, type) } EnterEnumList(Idlist, type) - struct node *Idlist; - register struct type *type; + t_node *Idlist; + register t_type *type; { /* Put a list of enumeration literals in the symbol table. They all have type "type". @@ -66,8 +66,8 @@ EnterEnumList(Idlist, type) be exported, in which case its literals must also be exported. Thus, we need an easy way to get to them. */ - register struct def *df; - register struct node *idlist = Idlist; + register t_def *df; + register t_node *idlist = Idlist; type->enm_ncst = 0; for (; idlist; idlist = idlist->nd_left) { @@ -81,8 +81,8 @@ EnterEnumList(Idlist, type) } EnterFieldList(Idlist, type, scope, addr) - struct node *Idlist; - register struct type *type; + t_node *Idlist; + register t_type *type; struct scope *scope; arith *addr; { @@ -91,8 +91,8 @@ EnterFieldList(Idlist, type, scope, addr) Mark them as QUALIFIED EXPORT, because that's exactly what fields are, you can get to them by qualifying them. */ - register struct def *df; - register struct node *idlist = Idlist; + register t_def *df; + register t_node *idlist = Idlist; for (; idlist; idlist = idlist->nd_left) { df = define(idlist->nd_IDF, scope, D_FIELD); @@ -105,16 +105,16 @@ EnterFieldList(Idlist, type, scope, addr) } EnterVarList(Idlist, type, local) - struct node *Idlist; - struct type *type; + t_node *Idlist; + t_type *type; { /* Enter a list of identifiers representing variables into the name list. "type" represents the type of the variables. "local" is set if the variables are declared local to a procedure. */ - register struct def *df; - register struct node *idlist = Idlist; + register t_def *df; + register t_node *idlist = Idlist; register struct scopelist *sc = CurrVis; char buf[256]; extern char *sprint(); @@ -132,7 +132,7 @@ EnterVarList(Idlist, type, local) if (idlist->nd_left) { /* An address was supplied */ - register struct type *tp = idlist->nd_left->nd_type; + register t_type *tp = idlist->nd_left->nd_type; df->df_flags |= D_ADDRGIVEN | D_NOREG; if (tp != error_type && !(tp->tp_fund & T_CARDINAL)){ @@ -180,8 +180,8 @@ EnterVarList(Idlist, type, local) EnterParamList(ppr, Idlist, type, VARp, off) struct paramlist **ppr; - struct node *Idlist; - struct type *type; + t_node *Idlist; + t_type *type; int VARp; arith *off; { @@ -190,9 +190,9 @@ EnterParamList(ppr, Idlist, type, VARp, off) "VARp" indicates D_VARPAR or D_VALPAR. */ register struct paramlist *pr; - register struct def *df; - register struct node *idlist = Idlist; - struct node *dummy = 0; + register t_def *df; + register t_node *idlist = Idlist; + t_node *dummy = 0; static struct paramlist *last; if (! idlist) { @@ -231,7 +231,7 @@ EnterParamList(ppr, Idlist, type, VARp, off) STATIC DoImport(df, scope) - register struct def *df; + register t_def *df; struct scope *scope; { /* Definition "df" is imported to scope "scope". @@ -268,8 +268,8 @@ DoImport(df, scope) STATIC struct scopelist * ForwModule(df, nd) - register struct def *df; - struct node *nd; + register t_def *df; + t_node *nd; { /* An import is done from a not yet defined module "df". We could also end up here for not found DEFINITION MODULES. @@ -295,15 +295,15 @@ ForwModule(df, nd) return vis; } -STATIC struct def * +STATIC t_def * ForwDef(ids, scope) - register struct node *ids; + register t_node *ids; struct scope *scope; { /* Enter a forward definition of "ids" in scope "scope", if it is not already defined. */ - register struct def *df; + register t_def *df; if (!(df = lookup(ids->nd_IDF, scope, 1))) { df = define(ids->nd_IDF, scope, D_FORWARD); @@ -313,15 +313,15 @@ ForwDef(ids, scope) } EnterExportList(Idlist, qualified) - struct node *Idlist; + t_node *Idlist; { /* From the current scope, the list of identifiers "ids" is exported. Note this fact. If the export is not qualified, make all the "ids" visible in the enclosing scope by defining them in this scope as "imported". */ - register struct node *idlist = Idlist; - register struct def *df, *df1; + register t_node *idlist = Idlist; + register t_def *df, *df1; for (;idlist; idlist = idlist->nd_left) { df = lookup(idlist->nd_IDF, CurrentScope, 0); @@ -389,15 +389,15 @@ EnterExportList(Idlist, qualified) } EnterFromImportList(Idlist, FromDef, FromId) - struct node *Idlist; - register struct def *FromDef; - struct node *FromId; + t_node *Idlist; + register t_def *FromDef; + t_node *FromId; { /* Import the list Idlist from the module indicated by Fromdef. */ - register struct node *idlist = Idlist; + register t_node *idlist = Idlist; register struct scopelist *vis; - register struct def *df; + register t_def *df; char *module_name = FromDef->df_idf->id_text; int forwflag = 0; @@ -454,16 +454,16 @@ node_error(FromId,"identifier \"%s\" does not represent a module",module_name); } EnterImportList(Idlist, local) - struct node *Idlist; + t_node *Idlist; { /* Import "Idlist" from the enclosing scope. An exception must be made for imports of the compilation unit. In this case, definition modules must be read for "Idlist". This case is indicated by the value 0 of the "local" flag. */ - register struct node *idlist = Idlist; + register t_node *idlist = Idlist; struct scope *sc = enclosing(CurrVis)->sc_scope; - extern struct def *GetDefinitionModule(); + extern t_def *GetDefinitionModule(); struct f_info f; f = file_info; diff --git a/lang/m2/comp/error.c b/lang/m2/comp/error.c index db6f665d2..e7a7a619f 100644 --- a/lang/m2/comp/error.c +++ b/lang/m2/comp/error.c @@ -73,7 +73,7 @@ error(fmt, args) /*VARARGS2*/ node_error(node, fmt, args) - struct node *node; + t_node *node; char *fmt; { _error(ERROR, node, fmt, &args); @@ -89,7 +89,7 @@ warning(class, fmt, args) /*VARARGS2*/ node_warning(node, class, fmt, args) - struct node *node; + t_node *node; char *fmt; { warn_class = class; @@ -137,7 +137,7 @@ crash(fmt, args) _error(class, node, fmt, argv) int class; - struct node *node; + t_node *node; char *fmt; int argv[]; { diff --git a/lang/m2/comp/expression.g b/lang/m2/comp/expression.g index 19b44bed6..36f299172 100644 --- a/lang/m2/comp/expression.g +++ b/lang/m2/comp/expression.g @@ -30,7 +30,7 @@ extern char options[]; } /* inline, we need room for pdp/11 -number(struct node **p;) : +number(t_node **p;) : [ %default INTEGER @@ -42,7 +42,7 @@ number(struct node **p;) : ; */ -qualident(struct node **p;) +qualident(t_node **p;) { } : IDENT { *p = dot2leaf(Name); } @@ -51,14 +51,14 @@ qualident(struct node **p;) ]* ; -selector(struct node **pnd;): +selector(t_node **pnd;): '.' { *pnd = dot2node(Link,*pnd,NULLNODE); } IDENT { (*pnd)->nd_IDF = dot.TOK_IDF; } ; -ExpList(struct node **pnd;) +ExpList(t_node **pnd;) { - register struct node *nd; + register t_node *nd; } : expression(pnd) { *pnd = nd = dot2node(Link,*pnd,NULLNODE); nd->nd_symb = ','; @@ -71,9 +71,9 @@ ExpList(struct node **pnd;) ]* ; -ConstExpression(struct node **pnd;) +ConstExpression(t_node **pnd;) { - register struct node *nd; + register t_node *nd; }: expression(pnd) /* @@ -94,7 +94,7 @@ ConstExpression(struct node **pnd;) } ; -expression(struct node **pnd;) +expression(t_node **pnd;) { } : SimpleExpression(pnd) @@ -112,9 +112,9 @@ relation: ; */ -SimpleExpression(struct node **pnd;) +SimpleExpression(t_node **pnd;) { - register struct node *nd = 0; + register t_node *nd = 0; } : [ [ '+' | '-' ] @@ -144,9 +144,9 @@ AddOperator: ; */ -term(struct node **pnd;) +term(t_node **pnd;) { - register struct node *nd; + register t_node *nd; }: factor(pnd) { nd = *pnd; } [ @@ -164,9 +164,9 @@ MulOperator: ; */ -factor(register struct node **p;) +factor(register t_node **p;) { - struct node *nd; + t_node *nd; } : qualident(p) [ @@ -208,7 +208,7 @@ factor(register struct node **p;) nd->nd_right = *p; *p = nd; } - else free_node(nd); + else FreeNode(nd); } ')' | @@ -216,9 +216,9 @@ factor(register struct node **p;) factor(&((*p)->nd_right)) ; -bare_set(struct node **pnd;) +bare_set(t_node **pnd;) { - register struct node *nd; + register t_node *nd; } : '{' { dot.tk_symb = SET; *pnd = nd = dot2leaf(Xset); @@ -233,13 +233,13 @@ bare_set(struct node **pnd;) '}' ; -ActualParameters(struct node **pnd;): +ActualParameters(t_node **pnd;): '(' ExpList(pnd)? ')' ; -element(register struct node *nd;) +element(register t_node *nd;) { - struct node *nd1; + t_node *nd1; } : expression(&nd1) [ @@ -252,13 +252,13 @@ element(register struct node *nd;) } ; -designator(struct node **pnd;) +designator(t_node **pnd;) : qualident(pnd) designator_tail(pnd)? ; -designator_tail(struct node **pnd;): +designator_tail(t_node **pnd;): visible_designator_tail(pnd) [ %persistent %default @@ -268,9 +268,9 @@ designator_tail(struct node **pnd;): ]* ; -visible_designator_tail(struct node **pnd;) +visible_designator_tail(t_node **pnd;) { - register struct node *nd = *pnd; + register t_node *nd = *pnd; }: [ '[' { nd = dot2node(Arrsel, nd, NULLNODE); } diff --git a/lang/m2/comp/idf.h b/lang/m2/comp/idf.h index 2c9fa76b5..14ec22187 100644 --- a/lang/m2/comp/idf.h +++ b/lang/m2/comp/idf.h @@ -19,3 +19,5 @@ struct id_u { #define id_def id_user.id_df #include + +typedef struct idf t_idf; diff --git a/lang/m2/comp/lookup.c b/lang/m2/comp/lookup.c index 7ef0b2ccc..6604c6418 100644 --- a/lang/m2/comp/lookup.c +++ b/lang/m2/comp/lookup.c @@ -23,9 +23,9 @@ #include "type.h" #include "misc.h" -struct def * +t_def * lookup(id, scope, import) - register struct idf *id; + register t_idf *id; struct scope *scope; { /* Look up a definition of an identifier in scope "scope". @@ -33,7 +33,7 @@ lookup(id, scope, import) Return a pointer to its "def" structure if it exists, otherwise return 0. */ - register struct def *df, *df1; + register t_def *df, *df1; /* Look in the chain of definitions of this "id" for one with scope "scope". @@ -62,16 +62,16 @@ lookup(id, scope, import) return df; } -struct def * +t_def * lookfor(id, vis, give_error) - register struct node *id; + register t_node *id; struct scopelist *vis; { /* Look for an identifier in the visibility range started by "vis". If it is not defined create a dummy definition and, if "give_error" is set, give an error message. */ - register struct def *df; + register t_def *df; register struct scopelist *sc = vis; while (sc) { diff --git a/lang/m2/comp/main.c b/lang/m2/comp/main.c index 329b7a8b3..e378e0186 100644 --- a/lang/m2/comp/main.c +++ b/lang/m2/comp/main.c @@ -37,11 +37,12 @@ char *ProgName; char **DEFPATH; int nDEF, mDEF; int pass_1; -struct def *Defined; +t_def *Defined; extern int err_occurred; extern int Roption; extern int fp_used; /* set if floating point used */ -struct node *EmptyStatement; +static t_node _emptystat = { NULLNODE, NULLNODE, Stat, NULLTYPE, { ';' }}; +t_node *EmptyStatement = &_emptystat; main(argc, argv) register char **argv; @@ -88,8 +89,6 @@ Compile(src, dst) InitScope(); InitTypes(); AddStandards(); - EmptyStatement = dot2leaf(Stat); - EmptyStatement->nd_symb = ';'; Roption = options['R']; #ifdef DEBUG if (options['l']) { @@ -124,7 +123,7 @@ Compile(src, dst) #ifdef DEBUG LexScan() { - register struct token *tkp = ˙ + register t_token *tkp = ˙ extern char *symbol2str(); while (LLlex() > 0) { @@ -184,13 +183,13 @@ static struct stdproc { { 0, 0 } }; -extern struct def *Enter(); +extern t_def *Enter(); AddStandards() { - register struct def *df; + register t_def *df; register struct stdproc *p; - static struct token nilconst = { INTEGER, 0}; + static t_token nilconst = { INTEGER, 0}; for (p = stdproc; p->st_nam != 0; p++) { Enter(p->st_nam, D_PROCEDURE, std_type, p->st_con); diff --git a/lang/m2/comp/misc.c b/lang/m2/comp/misc.c index cf2581179..c9177acf4 100644 --- a/lang/m2/comp/misc.c +++ b/lang/m2/comp/misc.c @@ -20,7 +20,7 @@ #include "node.h" match_id(id1, id2) - register struct idf *id1, *id2; + register t_idf *id1, *id2; { /* Check that identifiers id1 and id2 are equal. If they are not, check that we did'nt generate them in the @@ -34,14 +34,14 @@ match_id(id1, id2) } } -struct idf * +t_idf * gen_anon_idf() { /* A new idf is created out of nowhere, to serve as an anonymous name. */ static int name_cnt; - char buff[100]; + char buff[512]; char *sprint(); sprint(buff, "#%d in %s, line %u", @@ -51,7 +51,7 @@ gen_anon_idf() not_declared(what, id, where) char *what, *where; - register struct node *id; + register t_node *id; { /* The identifier "id" is not declared. If it is not generated, give an error message diff --git a/lang/m2/comp/node.H b/lang/m2/comp/node.H index d7f3ed63a..a18ccc631 100644 --- a/lang/m2/comp/node.H +++ b/lang/m2/comp/node.H @@ -41,11 +41,13 @@ struct node { #define nd_REL nd_token.TOK_REL }; +typedef struct node t_node; + /* ALLOCDEF "node" 50 */ -extern struct node *MkNode(), *MkLeaf(), *dot2node(), *dot2leaf(); +extern t_node *MkNode(), *MkLeaf(), *dot2node(), *dot2leaf(); -#define NULLNODE ((struct node *) 0) +#define NULLNODE ((t_node *) 0) #define HASSELECTORS 002 #define VARIABLE 004 diff --git a/lang/m2/comp/node.c b/lang/m2/comp/node.c index f883c57fe..121e01c15 100644 --- a/lang/m2/comp/node.c +++ b/lang/m2/comp/node.c @@ -21,14 +21,14 @@ #include "type.h" #include "node.h" -struct node * +t_node * MkNode(class, left, right, token) - struct node *left, *right; - struct token *token; + t_node *left, *right; + t_token *token; { /* Create a node and initialize it with the given parameters */ - register struct node *nd = new_node(); + register t_node *nd = new_node(); nd->nd_left = left; nd->nd_right = right; @@ -37,32 +37,32 @@ MkNode(class, left, right, token) return nd; } -struct node * +t_node * dot2node(class, left, right) - struct node *left, *right; + t_node *left, *right; { return MkNode(class, left, right, &dot); } -struct node * +t_node * MkLeaf(class, token) - struct token *token; + t_token *token; { - register struct node *nd = new_node(); + register t_node *nd = new_node(); nd->nd_token = *token; nd->nd_class = class; return nd; } -struct node * +t_node * dot2leaf(class) { return MkLeaf(class, &dot); } FreeNode(nd) - register struct node *nd; + register t_node *nd; { /* Put nodes that are no longer needed back onto the free list @@ -74,7 +74,7 @@ FreeNode(nd) } NodeCrash(expp) - struct node *expp; + t_node *expp; { crash("Illegal node %d", expp->nd_class); } @@ -91,7 +91,7 @@ indnt(lvl) } printnode(nd, lvl) - register struct node *nd; + register t_node *nd; { indnt(lvl); print("Class: %d; Symbol: %s\n", nd->nd_class, symbol2str(nd->nd_symb)); @@ -104,7 +104,7 @@ printnode(nd, lvl) } PrNode(nd, lvl) - register struct node *nd; + register t_node *nd; { if (! nd) { indnt(lvl); print("\n"); diff --git a/lang/m2/comp/program.g b/lang/m2/comp/program.g index 8a1b90aa6..6fb2d64de 100644 --- a/lang/m2/comp/program.g +++ b/lang/m2/comp/program.g @@ -48,8 +48,8 @@ ModuleDeclaration { - register struct def *df; - struct node *exportlist = 0; + register t_def *df; + t_node *exportlist = 0; int qualified; } : MODULE IDENT { df = DefineLocalModule(dot.TOK_IDF); } @@ -66,7 +66,7 @@ ModuleDeclaration } ; -priority(register struct def *df;): +priority(register t_def *df;): [ '[' ConstExpression(&(df->mod_priority)) ']' { if (!(df->mod_priority->nd_type->tp_fund & @@ -80,7 +80,7 @@ priority(register struct def *df;): ] ; -export(int *QUALflag; struct node **ExportList;): +export(int *QUALflag; t_node **ExportList;): EXPORT [ QUALIFIED @@ -93,10 +93,10 @@ export(int *QUALflag; struct node **ExportList;): import(int local;) { - struct node *ImportList; - register struct node *FromId = 0; - register struct def *df; - extern struct def *GetDefinitionModule(); + t_node *ImportList; + register t_node *FromId = 0; + register t_def *df; + extern t_def *GetDefinitionModule(); } : [ FROM IDENT { FromId = dot2leaf(Name); @@ -120,10 +120,10 @@ import(int local;) DefinitionModule { - register struct def *df; - struct node *exportlist; + register t_def *df; + t_node *exportlist; int dummy; - extern struct idf *DefId; + extern t_idf *DefId; extern int ForeignFlag; } : DEFINITION @@ -157,7 +157,7 @@ node_warning(exportlist, W_OLDFASHIONED, "export list in definition module ignor /* empty */ ] definition* END IDENT - { register struct def *df1 = CurrentScope->sc_def; + { register t_def *df1 = CurrentScope->sc_def; while (df1) { /* Make all definitions "QUALIFIED EXPORT" */ df1->df_flags |= D_QEXPORTED; @@ -172,8 +172,8 @@ node_warning(exportlist, W_OLDFASHIONED, "export list in definition module ignor definition { - register struct def *df; - struct def *dummy; + register t_def *df; + t_def *dummy; } : CONST [ %persistent ConstantDeclaration ';' ]* | @@ -202,8 +202,8 @@ definition ProgramModule { - extern struct def *GetDefinitionModule(); - register struct def *df; + extern t_def *GetDefinitionModule(); + register t_def *df; } : MODULE IDENT { if (state == IMPLEMENTATION) { diff --git a/lang/m2/comp/scope.C b/lang/m2/comp/scope.C index b4978dec2..05ff093ee 100644 --- a/lang/m2/comp/scope.C +++ b/lang/m2/comp/scope.C @@ -82,7 +82,7 @@ InitScope() STATIC chk_proc(df) - register struct def *df; + register t_def *df; { /* Called at scope closing. Check all definitions, and if one is a D_PROCHEAD, the procedure was not defined. @@ -106,18 +106,18 @@ chk_proc(df) STATIC chk_forw(pdf) - struct def **pdf; + t_def **pdf; { /* Called at scope close. Look for all forward definitions and if the scope was a closed scope, give an error message for them, and otherwise move them to the enclosing scope. */ - register struct def *df; + register t_def *df; while (df = *pdf) { if (df->df_kind == D_FORWTYPE) { - register struct def *df1 = df; - register struct node *nd = df->df_forw_node; + register t_def *df1 = df; + register t_node *nd = df->df_forw_node; *pdf = df->df_nextinscope; RemoveFromIdList(df); @@ -134,7 +134,7 @@ node_error(nd, "\"%s\" is not a type", df1->df_idf->id_text); continue; } else if (df->df_kind == D_FTYPE) { - register struct node *nd = df->df_forw_node; + register t_node *nd = df->df_forw_node; df->df_kind = D_TYPE; while (nd) { @@ -163,7 +163,7 @@ df->df_idf->id_text); */ register struct scopelist *ls = nextvisible(CurrVis); - struct def *df1 = df->df_nextinscope; + t_def *df1 = df->df_nextinscope; if (df->df_kind == D_FORWMODULE) { df->for_vis->sc_next = ls; @@ -180,14 +180,14 @@ df->df_idf->id_text); } Reverse(pdf) - struct def **pdf; + t_def **pdf; { /* Reverse the order in the list of definitions in a scope. This is neccesary because this list is built in reverse. Also, while we're at it, remove uninteresting definitions from this list. */ - register struct def *df, *df1; + register t_def *df, *df1; #define INTERESTING D_MODULE|D_PROCEDURE|D_PROCHEAD|D_VARIABLE df = 0; @@ -195,7 +195,7 @@ Reverse(pdf) while (df1) { if (df1->df_kind & INTERESTING) { - struct def *prev = df; + t_def *prev = df; df = df1; df1 = df1->df_nextinscope; @@ -228,7 +228,7 @@ close_scope(flag) #ifdef DEBUG DumpScope(df) - register struct def *df; + register t_def *df; { while (df) { PrDef(df); diff --git a/lang/m2/comp/statement.g b/lang/m2/comp/statement.g index 600b126fa..25c96e65a 100644 --- a/lang/m2/comp/statement.g +++ b/lang/m2/comp/statement.g @@ -24,12 +24,12 @@ static int loopcount = 0; /* Count nested loops */ int Roption; extern char options[]; -extern struct node *EmptyStatement; +extern t_node *EmptyStatement; } -statement(register struct node **pnd;) +statement(register t_node **pnd;) { - register struct node *nd; + register t_node *nd; extern int return_occurred; } : /* We need some method for making sure lookahead is done, so ... @@ -56,7 +56,7 @@ statement(register struct node **pnd;) * but this gives LL(1) conflicts */ designator(pnd) - [ { nd = dot2node(Call, *pnd, NULLNODE); + [ { nd = dot2node(Stat, *pnd, NULLNODE); nd->nd_symb = '('; } ActualParameters(&(nd->nd_right))? @@ -123,10 +123,10 @@ ProcedureCall: ; */ -StatementSequence(register struct node **pnd;) +StatementSequence(register t_node **pnd;) { - struct node *nd; - register struct node *nd1; + t_node *nd; + register t_node *nd1; } : statement(pnd) [ %persistent @@ -140,9 +140,9 @@ StatementSequence(register struct node **pnd;) ]* ; -IfStatement(struct node **pnd;) +IfStatement(t_node **pnd;) { - register struct node *nd; + register t_node *nd; } : IF { nd = dot2leaf(Stat); *pnd = nd; @@ -170,10 +170,10 @@ IfStatement(struct node **pnd;) END ; -CaseStatement(struct node **pnd;) +CaseStatement(t_node **pnd;) { - register struct node *nd; - struct type *tp = 0; + register t_node *nd; + t_type *tp = 0; } : CASE { *pnd = nd = dot2leaf(Stat); } expression(&(nd->nd_left)) @@ -190,7 +190,7 @@ CaseStatement(struct node **pnd;) END ; -case(struct node **pnd; struct type **ptp;) : +case(t_node **pnd; t_type **ptp;) : [ CaseLabelList(ptp, pnd) ':' { *pnd = dot2node(Link, *pnd, NULLNODE); } StatementSequence(&((*pnd)->nd_right)) @@ -201,9 +201,9 @@ case(struct node **pnd; struct type **ptp;) : ; /* inline in statement; lack of space -WhileStatement(struct node **pnd;) +WhileStatement(t_node **pnd;) { - register struct node *nd; + register t_node *nd; }: WHILE { *pnd = nd = dot2leaf(Stat); } expression(&(nd->nd_left)) @@ -212,9 +212,9 @@ WhileStatement(struct node **pnd;) END ; -RepeatStatement(struct node **pnd;) +RepeatStatement(t_node **pnd;) { - register struct node *nd; + register t_node *nd; }: REPEAT { *pnd = nd = dot2leaf(Stat); } StatementSequence(&(nd->nd_left)) @@ -223,10 +223,10 @@ RepeatStatement(struct node **pnd;) ; */ -ForStatement(struct node **pnd;) +ForStatement(t_node **pnd;) { - register struct node *nd, *nd1; - struct node *dummy; + register t_node *nd, *nd1; + t_node *dummy; }: FOR { *pnd = nd = dot2leaf(Stat); } IDENT { nd->nd_IDF = dot.TOK_IDF; } @@ -252,16 +252,16 @@ ForStatement(struct node **pnd;) ; /* inline in Statement; lack of space -LoopStatement(struct node **pnd;): +LoopStatement(t_node **pnd;): LOOP { *pnd = dot2leaf(Stat); } StatementSequence(&((*pnd)->nd_right)) END ; */ -WithStatement(struct node **pnd;) +WithStatement(t_node **pnd;) { - register struct node *nd; + register t_node *nd; }: WITH { *pnd = nd = dot2leaf(Stat); } designator(&(nd->nd_left)) @@ -270,10 +270,10 @@ WithStatement(struct node **pnd;) END ; -ReturnStatement(struct node **pnd;) +ReturnStatement(t_node **pnd;) { - register struct def *df = CurrentScope->sc_definedby; - register struct node *nd; + register t_def *df = CurrentScope->sc_definedby; + register t_node *nd; } : RETURN { *pnd = nd = dot2leaf(Stat); } diff --git a/lang/m2/comp/tokenname.c b/lang/m2/comp/tokenname.c index e719acd2f..779076701 100644 --- a/lang/m2/comp/tokenname.c +++ b/lang/m2/comp/tokenname.c @@ -102,7 +102,7 @@ reserve(resv) /* The names of the tokens described in resv are entered as reserved words. */ - register struct idf *p; + register t_idf *p; while (resv->tn_symbol) { p = str2idf(resv->tn_name, 0); diff --git a/lang/m2/comp/type.H b/lang/m2/comp/type.H index 784f3a5cb..fdbaf7bdb 100644 --- a/lang/m2/comp/type.H +++ b/lang/m2/comp/type.H @@ -99,9 +99,11 @@ struct type { } tp_value; }; +typedef struct type t_type; + /* ALLOCDEF "type" 50 */ -extern struct type +extern t_type *bool_type, *char_type, *int_type, @@ -140,7 +142,7 @@ extern arith extern arith align(); /* type.c */ -struct type +extern t_type *construct_type(), *standard_type(), *set_type(), @@ -150,7 +152,7 @@ struct type *qualified_type(), *RemoveEqual(); /* All from type.c */ -#define NULLTYPE ((struct type *) 0) +#define NULLTYPE ((t_type *) 0) #define IsConformantArray(tpx) ((tpx)->tp_fund==T_ARRAY && (tpx)->tp_size==0) #define bounded(tpx) ((tpx)->tp_fund & T_INDEX) diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c index bde89b719..b6cc0accb 100644 --- a/lang/m2/comp/type.c +++ b/lang/m2/comp/type.c @@ -19,6 +19,7 @@ #include #include +#include "squeeze.h" #include "LLlex.h" #include "def.h" #include "type.h" @@ -52,7 +53,7 @@ arith double_size = SZ_DOUBLE, pointer_size = SZ_POINTER; -struct type +t_type *bool_type, *char_type, *int_type, @@ -68,15 +69,15 @@ struct type *std_type, *error_type; -struct type * +t_type * construct_type(fund, tp) int fund; - register struct type *tp; + register t_type *tp; { /* fund must be a type constructor. The pointer to the constructed type is returned. */ - register struct type *dtp = new_type(); + register t_type *dtp = new_type(); switch (dtp->tp_fund = fund) { case T_PROCEDURE: @@ -121,13 +122,13 @@ align(pos, al) return pos; } -struct type * +t_type * standard_type(fund, align, size) int fund; int align; arith size; { - register struct type *tp = new_type(); + register t_type *tp = new_type(); tp->tp_fund = fund; tp->tp_align = align; @@ -143,7 +144,7 @@ InitTypes() { /* Initialize the predefined types */ - register struct type *tp; + register t_type *tp; /* first, do some checking */ @@ -215,7 +216,7 @@ InitTypes() STATIC u_small(tp, n) - register struct type *tp; + register t_type *tp; arith n; { if (ufit(n, 1)) { @@ -228,11 +229,11 @@ u_small(tp, n) } } -struct type * +t_type * enum_type(EnumList) - struct node *EnumList; + t_node *EnumList; { - register struct type *tp = + register t_type *tp = standard_type(T_ENUMERATION, int_align, int_size); EnterEnumList(EnumList, tp); @@ -243,11 +244,11 @@ enum_type(EnumList) return tp; } -struct type * +t_type * qualified_type(nd) - register struct node *nd; + register t_node *nd; { - register struct def *df; + register t_def *df; if (ChkDesignator(nd)) { if (nd->nd_class != Def) { @@ -276,7 +277,7 @@ node_error(nd,"identifier \"%s\" is not a type", df->df_idf->id_text); } chk_basesubrange(tp, base) - register struct type *tp, *base; + register t_type *tp, *base; { /* A subrange had a specified base. Check that the bases conform. */ @@ -330,17 +331,17 @@ chk_bounds(l1, l2, fund) ); } -struct type * +t_type * subr_type(lb, ub) - register struct node *lb; - struct node *ub; + register t_node *lb; + t_node *ub; { /* Construct a subrange type from the constant expressions indicated by "lb" and "ub", but first perform some checks */ - register struct type *tp = BaseType(lb->nd_type); - register struct type *res; + register t_type *tp = BaseType(lb->nd_type); + register t_type *res; if (tp == intorcard_type) { /* Lower bound >= 0; in this case, the base type is CARDINAL, @@ -389,13 +390,13 @@ subr_type(lb, ub) return res; } -struct type * +t_type * proc_type(result_type, parameters, n_bytes_params) - struct type *result_type; + t_type *result_type; struct paramlist *parameters; arith n_bytes_params; { - register struct type *tp = construct_type(T_PROCEDURE, result_type); + register t_type *tp = construct_type(T_PROCEDURE, result_type); tp->prc_params = parameters; tp->prc_nbpar = n_bytes_params; @@ -403,7 +404,7 @@ proc_type(result_type, parameters, n_bytes_params) } genrck(tp) - register struct type *tp; + register t_type *tp; { /* generate a range check descriptor for type "tp" when neccessary. Return its label. @@ -426,12 +427,12 @@ genrck(tp) C_rom_cst(lb); C_rom_cst(ub); } - C_lae_dlb(ol, (arith) 0); + c_lae_dlb(ol); C_rck(word_size); } getbounds(tp, plo, phi) - register struct type *tp; + register t_type *tp; arith *plo, *phi; { /* Get the bounds of a bounded type @@ -449,9 +450,9 @@ getbounds(tp, plo, phi) } } -struct type * +t_type * set_type(tp) - register struct type *tp; + register t_type *tp; { /* Construct a set type with base type "tp", but first perform some checks @@ -477,7 +478,7 @@ set_type(tp) arith ArrayElSize(tp) - register struct type *tp; + register t_type *tp; { /* Align element size to alignment requirement of element type. Also make sure that its size is either a dividor of the word_size, @@ -497,12 +498,12 @@ ArrayElSize(tp) } ArraySizes(tp) - register struct type *tp; + register t_type *tp; { /* Assign sizes to an array type, and check index type */ - register struct type *index_type = IndexType(tp); - register struct type *elem_type = tp->arr_elem; + register t_type *index_type = IndexType(tp); + register t_type *elem_type = tp->arr_elem; arith lo, hi, diff; tp->arr_elsize = ArrayElSize(elem_type); @@ -531,7 +532,7 @@ ArraySizes(tp) } FreeType(tp) - register struct type *tp; + register t_type *tp; { /* Release type structures indicated by "tp". This procedure is only called for types, constructed with @@ -553,9 +554,9 @@ FreeType(tp) } DeclareType(nd, df, tp) - register struct def *df; - register struct type *tp; - struct node *nd; + register t_def *df; + register t_type *tp; + t_node *nd; { /* A type with type-description "tp" is declared and must be bound to definition "df". @@ -563,7 +564,7 @@ DeclareType(nd, df, tp) "df" is already bound. In that case, it is either an opaque type, or an error message was given when "df" was created. */ - register struct type *df_tp = df->df_type; + register t_type *df_tp = df->df_type; if (df_tp && df_tp->tp_fund == T_HIDDEN) { if (! (tp->tp_fund & (T_POINTER|T_HIDDEN|T_EQUAL))) { @@ -586,9 +587,9 @@ DeclareType(nd, df, tp) else df->df_type = tp; } -struct type * +t_type * RemoveEqual(tpx) - register struct type *tpx; + register t_type *tpx; { if (tpx) while (tpx->tp_fund == T_EQUAL) tpx = tpx->tp_next; @@ -597,29 +598,26 @@ RemoveEqual(tpx) int type_or_forward(ptp) - struct type **ptp; + t_type **ptp; { /* POINTER TO IDENTIFIER construction. The IDENTIFIER resides in "dot". This routine handles the different cases. */ - register struct node *nd; - register struct def *df, *df1; + register t_node *nd; + register t_def *df, *df1; if ((df1 = lookup(dot.TOK_IDF, CurrentScope, 1))) { /* Either a Module or a Type, but in both cases defined in this scope, so this is the correct identification */ if (df1->df_kind == D_FORWTYPE) { - nd = new_node(); - nd->nd_token = dot; - nd->nd_right = df1->df_forw_node; + nd = dot2node(NULLNODE, df1->df_forw_node, 0); df1->df_forw_node = nd; nd->nd_type = *ptp; } return 1; } - nd = new_node(); - nd->nd_token = dot; + nd = dot2leaf(0); if ((df1 = lookfor(nd, CurrVis, 0))->df_kind == D_MODULE) { /* A Modulename in one of the enclosing scopes. It is not clear from the language definition that @@ -629,7 +627,7 @@ type_or_forward(ptp) one token. ??? */ - free_node(nd); + FreeNode(nd); return 1; } /* Enter a forward reference into a list belonging to the @@ -641,7 +639,7 @@ type_or_forward(ptp) if (df->df_kind == D_TYPE) { (*ptp)->tp_next = df->df_type; - free_node(nd); + FreeNode(nd); return 0; } nd->nd_type = *ptp; @@ -679,7 +677,7 @@ lcm(m, n) #ifdef DEBUG DumpType(tp) - register struct type *tp; + register t_type *tp; { if (!tp) return; diff --git a/lang/m2/comp/typequiv.c b/lang/m2/comp/typequiv.c index 1e0f2c40b..a10289571 100644 --- a/lang/m2/comp/typequiv.c +++ b/lang/m2/comp/typequiv.c @@ -29,7 +29,7 @@ extern char *sprint(); int TstTypeEquiv(tp1, tp2) - struct type *tp1, *tp2; + t_type *tp1, *tp2; { /* test if two types are equivalent. */ @@ -43,7 +43,7 @@ TstTypeEquiv(tp1, tp2) int TstParEquiv(tp1, tp2) - register struct type *tp1, *tp2; + register t_type *tp1, *tp2; { /* test if two parameter types are equivalent. This routine is used to check if two different procedure declarations @@ -66,7 +66,7 @@ TstParEquiv(tp1, tp2) int TstProcEquiv(tp1, tp2) - struct type *tp1, *tp2; + t_type *tp1, *tp2; { /* Test if two procedure types are equivalent. This routine may also be used for the testing of assignment compatibility @@ -98,7 +98,7 @@ TstProcEquiv(tp1, tp2) int TstCompat(tp1, tp2) - register struct type *tp1, *tp2; + register t_type *tp1, *tp2; { /* test if two types are compatible. See section 6.3 of the Modula-2 Report for a definition of "compatible". @@ -110,7 +110,7 @@ TstCompat(tp1, tp2) tp2 = BaseType(tp2); if (tp2 != intorcard_type && (tp1 == intorcard_type || tp1 == address_type)) { - struct type *tmp = tp2; + t_type *tmp = tp2; tp2 = tp1; tp1 = tmp; @@ -132,12 +132,12 @@ TstCompat(tp1, tp2) int TstAssCompat(tp1, tp2) - register struct type *tp1, *tp2; + register t_type *tp1, *tp2; { /* Test if two types are assignment compatible. See Def 9.1. */ - register struct type *tp; + register t_type *tp; if (TstCompat(tp1, tp2)) return 1; @@ -179,9 +179,9 @@ TstAssCompat(tp1, tp2) int TstParCompat(parno, formaltype, VARflag, nd, edf) - register struct type *formaltype; - struct node **nd; - struct def *edf; + register t_type *formaltype; + t_node **nd; + t_def *edf; { /* Check type compatibility for a parameter in a procedure call. Assignment compatibility may do if the parameter is @@ -190,7 +190,7 @@ TstParCompat(parno, formaltype, VARflag, nd, edf) may do too. Or: a WORD may do. */ - register struct type *actualtype = (*nd)->nd_type; + register t_type *actualtype = (*nd)->nd_type; char ebuf[256]; char ebuf1[256]; @@ -258,8 +258,8 @@ TstParCompat(parno, formaltype, VARflag, nd, edf) } CompatCheck(nd, tp, message, fc) - struct node **nd; - struct type *tp; + t_node **nd; + t_type *tp; char *message; int (*fc)(); { @@ -274,8 +274,8 @@ CompatCheck(nd, tp, message, fc) } ChkAssCompat(nd, tp, message) - struct node **nd; - struct type *tp; + t_node **nd; + t_type *tp; char *message; { /* Check assignment compatibility of node "nd" with type "tp". @@ -286,8 +286,8 @@ ChkAssCompat(nd, tp, message) } ChkCompat(nd, tp, message) - struct node **nd; - struct type *tp; + t_node **nd; + t_type *tp; char *message; { /* Check compatibility of node "nd" with type "tp". diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c index 7a26411bb..ced9c3fb5 100644 --- a/lang/m2/comp/walk.c +++ b/lang/m2/comp/walk.c @@ -23,6 +23,7 @@ #include #include +#include "squeeze.h" #include "LLlex.h" #include "def.h" #include "type.h" @@ -37,19 +38,32 @@ #include "walk.h" #include "warning.h" -extern arith NewPtr(); -extern arith NewInt(); -extern int proclevel; -label text_label; -label data_label = 1; -static struct type *func_type; -struct withdesig *WithDesigs; -struct node *Modules; -static struct node *priority; +extern arith NewPtr(); +extern arith NewInt(); +extern int proclevel; +label text_label; +label data_label = 1; +static t_type *func_type; +struct withdesig *WithDesigs; +t_node *Modules; +static arith priority; #define NO_EXIT_LABEL ((label) 0) #define RETURN_LABEL ((label) 1) +LblWalkNode(lbl, nd, exit) + label lbl, exit; + register t_node *nd; +{ + /* Generate code for node "nd", after generating instruction + label "lbl". "exit" is the exit label for the closest + enclosing LOOP. + */ + + C_df_ilb(lbl); + WalkNode(nd, exit); +} + STATIC DoPriority() { @@ -57,10 +71,8 @@ DoPriority() the runtime system */ - register struct node *p; - - if (p = priority) { - C_loc(p->nd_INT); + if (priority) { + C_loc(priority); C_cal("_stackprio"); C_asp(word_size); } @@ -92,7 +104,7 @@ DoProfil() } WalkModule(module) - register struct def *module; + register t_def *module; { /* Walk through a module, and all its local definitions. Also generate code for its body. @@ -102,7 +114,7 @@ WalkModule(module) struct scopelist *savevis = CurrVis; CurrVis = module->mod_vis; - priority = module->mod_priority; + priority = module->mod_priority ? module->mod_priority->nd_INT : 0; sc = CurrentScope; /* Walk through it's local definitions @@ -124,7 +136,7 @@ WalkModule(module) Call initialization routines of imported modules. Also prevent recursive calls of this one. */ - register struct node *nd = Modules; + register t_node *nd = Modules; if (state == IMPLEMENTATION) { /* We don't actually prevent recursive calls, @@ -159,14 +171,14 @@ WalkModule(module) } WalkProcedure(procedure) - register struct def *procedure; + register t_def *procedure; { /* Walk through the definition of a procedure and all its local definitions, checking and generating code. */ struct scopelist *savevis = CurrVis; register struct scope *sc = procedure->prc_vis->sc_scope; - register struct type *tp; + register t_type *tp; register struct paramlist *param; label func_res_label = 0; arith StackAdjustment = 0; @@ -276,7 +288,7 @@ WalkProcedure(procedure) WalkNode(procedure->prc_body, NO_EXIT_LABEL); DO_DEBUG(options['X'], PrNode(procedure->prc_body, 0)); if (func_res_size) { - C_loc((arith) M2_NORESULT); + c_loc(M2_NORESULT); C_trp(); C_asp(-func_res_size); } @@ -285,7 +297,7 @@ WalkProcedure(procedure) /* Fill the data area reserved for the function result with the result */ - C_lae_dlb(func_res_label, (arith) 0); + c_lae_dlb(func_res_label); C_sti(func_res_size); if (StackAdjustment) { /* Remove copies of conformant arrays @@ -293,7 +305,7 @@ WalkProcedure(procedure) C_lol(StackAdjustment); C_str((arith) 1); } - C_lae_dlb(func_res_label, (arith) 0); + c_lae_dlb(func_res_label); func_res_size = pointer_size; } else if (StackAdjustment) { @@ -323,7 +335,7 @@ WalkProcedure(procedure) } WalkDef(df) - register struct def *df; + register t_def *df; { /* Walk through a list of definitions */ @@ -352,7 +364,7 @@ WalkDef(df) } MkCalls(df) - register struct def *df; + register t_def *df; { /* Generate calls to initialization routines of modules */ @@ -367,7 +379,7 @@ MkCalls(df) } WalkLink(nd, exit_label) - register struct node *nd; + register t_node *nd; label exit_label; { /* Walk node "nd", which is a link. @@ -381,44 +393,39 @@ WalkLink(nd, exit_label) WalkNode(nd, exit_label); } -WalkCall(nd) - register struct node *nd; -{ - assert(nd->nd_class == Call); - - if (! options['L']) C_lin((arith) nd->nd_lineno); - if (ChkCall(nd)) { - if (nd->nd_type != 0) { - node_error(nd, "procedure call expected"); - return; - } - CodeCall(nd); - } -} - STATIC ForLoopVarExpr(nd) - register struct node *nd; + register t_node *nd; { - register struct type *tp = nd->nd_type; + register t_type *tp = nd->nd_type; CodePExpr(nd); CodeCoercion(tp, BaseType(tp)); } WalkStat(nd, exit_label) - register struct node *nd; + register t_node *nd; label exit_label; { /* Walk through a statement, generating code for it. */ - register struct node *left = nd->nd_left; - register struct node *right = nd->nd_right; + register t_node *left = nd->nd_left; + register t_node *right = nd->nd_right; assert(nd->nd_class == Stat); if (! options['L'] && nd->nd_lineno) C_lin((arith) nd->nd_lineno); switch(nd->nd_symb) { + case '(': + if (ChkCall(nd)) { + if (nd->nd_type != 0) { + node_error(nd, "procedure call expected"); + break; + } + CodeCall(nd); + } + break; + case ';': break; @@ -431,15 +438,13 @@ WalkStat(nd, exit_label) ExpectBool(left, l3, l1); assert(right->nd_symb == THEN); - C_df_ilb(l3); - WalkNode(right->nd_left, exit_label); + LblWalkNode(l3, right->nd_left, exit_label); if (right->nd_right) { /* ELSE part */ label l2 = ++text_label; C_bra(l2); - C_df_ilb(l1); - WalkNode(right->nd_right, exit_label); + LblWalkNode(l1, right->nd_right, exit_label); l1 = l2; } C_df_ilb(l1); @@ -457,8 +462,7 @@ WalkStat(nd, exit_label) C_df_ilb(loop); ExpectBool(left, dummy, exit); - C_df_ilb(dummy); - WalkNode(right, exit_label); + LblWalkNode(dummy, right, exit_label); C_bra(loop); C_df_ilb(exit); break; @@ -467,8 +471,7 @@ WalkStat(nd, exit_label) case REPEAT: { label loop = ++text_label, exit = ++text_label; - C_df_ilb(loop); - WalkNode(left, exit_label); + LblWalkNode(loop, left, exit_label); ExpectBool(right, exit, loop); C_df_ilb(exit); break; @@ -477,8 +480,7 @@ WalkStat(nd, exit_label) case LOOP: { label loop = ++text_label, exit = ++text_label; - C_df_ilb(loop); - WalkNode(right, exit); + LblWalkNode(loop, right, exit); C_bra(loop); C_df_ilb(exit); break; @@ -488,13 +490,13 @@ WalkStat(nd, exit_label) { arith tmp = NewInt(); arith tmp2; - register struct node *fnd; + register t_node *fnd; int good_forvar; label l1 = ++text_label; label l2 = ++text_label; int uns = 0; arith stepsize; - struct type *bstp; + t_type *bstp; good_forvar = DoForInit(nd); if ((stepsize = left->nd_INT) == 0) { @@ -551,7 +553,7 @@ WalkStat(nd, exit_label) C_lol(tmp); C_zeq(l2); C_lol(tmp); - C_loc((arith) 1); + c_loc(1); C_sbu(int_size); C_stl(tmp); C_loc(left->nd_INT); @@ -575,7 +577,7 @@ WalkStat(nd, exit_label) { struct scopelist link; struct withdesig wds; - struct desig ds; + t_desig ds; if (! WalkDesignator(left, &ds)) break; if (left->nd_type->tp_fund != T_RECORD) { @@ -640,7 +642,7 @@ extern int NodeCrash(); STATIC WalkOption(nd) - struct node *nd; + t_node *nd; { /* Set option indicated by node "nd" */ @@ -654,7 +656,7 @@ int (*WalkTable[])() = { NodeCrash, NodeCrash, NodeCrash, - WalkCall, + NodeCrash, NodeCrash, NodeCrash, NodeCrash, @@ -665,13 +667,13 @@ int (*WalkTable[])() = { }; ExpectBool(nd, true_label, false_label) - register struct node *nd; + register t_node *nd; label true_label, false_label; { /* "nd" must indicate a boolean expression. Check this and generate code to evaluate the expression. */ - register struct desig *ds = new_desig(); + register t_desig *ds = new_desig(); if (ChkExpression(nd)) { if (nd->nd_type != bool_type && nd->nd_type != error_type) { @@ -685,25 +687,25 @@ ExpectBool(nd, true_label, false_label) int WalkDesignator(nd, ds) - struct node *nd; - struct desig *ds; + t_node *nd; + t_desig *ds; { /* Check designator and generate code for it */ if (! ChkVariable(nd)) return 0; - clear((char *) ds, sizeof(struct desig)); + clear((char *) ds, sizeof(t_desig)); CodeDesig(nd, ds); return 1; } DoForInit(nd) - register struct node *nd; + register t_node *nd; { - register struct node *left = nd->nd_left; - register struct def *df; - struct type *tpl, *tpr; + register t_node *left = nd->nd_left; + register t_def *df; + t_type *tpl, *tpr; nd->nd_left = nd->nd_right = 0; nd->nd_class = Name; @@ -761,16 +763,16 @@ node_warning(nd, W_OLDFASHIONED, "compatibility required in FOR statement"); } DoAssign(left, right) - register struct node *left; - struct node *right; + register t_node *left; + t_node *right; { /* May we do it in this order (expression first) ??? The reference manual sais nothing about it, but the book does: it sais that the left hand side is evaluated first. DAMN THE BOOK! */ - register struct desig *dsr; - register struct type *tp; + register t_desig *dsr; + register t_type *tp; if (! (ChkExpression(right) & ChkVariable(left))) return; tp = left->nd_type; @@ -797,9 +799,9 @@ DoAssign(left, right) } RegisterMessages(df) - register struct def *df; + register t_def *df; { - register struct type *tp; + register t_type *tp; arith sz; int regtype = -1; diff --git a/lang/m2/comp/walk.h b/lang/m2/comp/walk.h index 7d3e23167..2c9c9da8f 100644 --- a/lang/m2/comp/walk.h +++ b/lang/m2/comp/walk.h @@ -18,3 +18,8 @@ extern int (*WalkTable[])(); extern label text_label; extern label data_label; + +#ifndef SQUEEZE +#define c_loc(x) C_loc((arith) (x)) +#define c_lae_dlb(x) C_lae_dlb(x,(arith) 0) +#endif