From f9b6acf1dcf5ca83bb0fc3c72a4c25501e828e59 Mon Sep 17 00:00:00 2001 From: ceriel Date: Mon, 20 Mar 1989 13:32:06 +0000 Subject: [PATCH] New version with different parameter passing mechanism and some minor fixes --- lang/m2/comp/LLlex.c | 8 +- lang/m2/comp/Version.c | 2 +- lang/m2/comp/casestat.C | 45 +++++------ lang/m2/comp/chk_expr.c | 26 +++---- lang/m2/comp/code.c | 6 +- lang/m2/comp/cstoper.c | 10 ++- lang/m2/comp/declar.g | 2 +- lang/m2/comp/desig.H | 1 + lang/m2/comp/desig.c | 12 ++- lang/m2/comp/enter.c | 2 +- lang/m2/comp/main.c | 2 +- lang/m2/comp/type.H | 7 +- lang/m2/comp/type.c | 8 +- lang/m2/comp/walk.c | 169 +++++++++++++++++++++++++++++----------- lang/m2/comp/walk.h | 2 +- 15 files changed, 197 insertions(+), 105 deletions(-) diff --git a/lang/m2/comp/LLlex.c b/lang/m2/comp/LLlex.c index 28379a683..99940f1cd 100644 --- a/lang/m2/comp/LLlex.c +++ b/lang/m2/comp/LLlex.c @@ -152,9 +152,11 @@ GetString(upto) } } str->s_length = p - str->s_str; - *p = '\0'; - str->s_str = Realloc(str->s_str, - (unsigned)((str->s_length+(int)word_size) & ~((int)word_size-1))); + len = (str->s_length+(int)word_size) & ~((int)word_size-1); + while (p - str->s_str < len) { + *p++ = '\0'; + } + str->s_str = Realloc(str->s_str, (unsigned) len); if (str->s_length == 0) str->s_length = 1; /* ??? string length at least 1 ??? */ return str; diff --git a/lang/m2/comp/Version.c b/lang/m2/comp/Version.c index 02e17914a..63770bc68 100644 --- a/lang/m2/comp/Version.c +++ b/lang/m2/comp/Version.c @@ -1 +1 @@ -static char Version[] = "ACK Modula-2 compiler Version 0.47"; +static char Version[] = "ACK Modula-2 compiler Version 0.48"; diff --git a/lang/m2/comp/casestat.C b/lang/m2/comp/casestat.C index e21c54274..1ffec8c0e 100644 --- a/lang/m2/comp/casestat.C +++ b/lang/m2/comp/casestat.C @@ -77,7 +77,8 @@ compact(nr, low, up) diff / nr <= (DENSITY - 1)); } -CaseCode(nd, exitlabel) +int +CaseCode(nd, exitlabel, end_reached) t_node *nd; label exitlabel; { @@ -91,6 +92,7 @@ CaseCode(nd, exitlabel) register struct case_entry *ce; register arith val; label CaseDescrLab; + int rval; assert(pnode->nd_class == Stat && pnode->nd_symb == CASE); @@ -109,15 +111,12 @@ CaseCode(nd, exitlabel) /* non-empty case */ pnode->nd_lab = ++text_label; - if (! AddCases(sh, /* to descriptor */ - pnode->nd_left->nd_left, - /* of case labels */ - pnode->nd_lab - /* and code label */ - )) { - FreeSh(sh); - return; - } + AddCases(sh, /* to descriptor */ + pnode->nd_left->nd_left, + /* of case labels */ + pnode->nd_lab + /* and code label */ + ); } } else { @@ -135,8 +134,6 @@ CaseCode(nd, exitlabel) */ if (! (sh->sh_type->tp_fund & T_DISCRETE)) { node_error(nd, "illegal type in CASE-expression"); - FreeSh(sh); - return; } } @@ -184,12 +181,13 @@ CaseCode(nd, exitlabel) /* Now generate code for the cases */ pnode = nd; + rval = 0; while (pnode = pnode->nd_right) { if (pnode->nd_class == Link && pnode->nd_symb == '|') { if (pnode->nd_left) { - LblWalkNode(pnode->nd_lab, + rval |= LblWalkNode(pnode->nd_lab, pnode->nd_left->nd_right, - exitlabel); + exitlabel, end_reached); C_bra(sh->sh_break); } } @@ -198,13 +196,15 @@ CaseCode(nd, exitlabel) */ assert(sh->sh_default != 0); - LblWalkNode(sh->sh_default, pnode, exitlabel); + rval |= LblWalkNode(sh->sh_default, + pnode, exitlabel, end_reached); break; } } def_ilb(sh->sh_break); FreeSh(sh); + return rval; } FreeSh(sh) @@ -241,22 +241,23 @@ AddCases(sh, node, lbl) node->nd_type = node->nd_left->nd_type; node->nd_INT = node->nd_left->nd_INT; for (;;) { - if (! AddOneCase(sh, node, lbl)) return 0; + AddOneCase(sh, node, lbl); if (node->nd_INT == node->nd_right->nd_INT) { break; } node->nd_INT++; } - return 1; + return; } assert(node->nd_symb == ','); - return AddCases(sh, node->nd_left, lbl) && - AddCases(sh, node->nd_right, lbl); + AddCases(sh, node->nd_left, lbl); + AddCases(sh, node->nd_right, lbl); + return; } assert(node->nd_class == Value); - return AddOneCase(sh, node, lbl); + AddOneCase(sh, node, lbl); } AddOneCase(sh, node, lbl) @@ -271,8 +272,6 @@ AddOneCase(sh, node, lbl) ce->ce_label = lbl; ce->ce_value = node->nd_INT; if (! ChkCompat(&node, sh->sh_type, "case")) { - free_case_entry(ce); - return 0; } if (sh->sh_entries == 0) { /* first case entry @@ -311,7 +310,6 @@ AddOneCase(sh, node, lbl) if (c1->ce_value == ce->ce_value) { node_error(node, "multiple case entry for value %ld", ce->ce_value); free_case_entry(ce); - return 0; } if (c2) { ce->ce_next = c2->ce_next; @@ -330,5 +328,4 @@ node_error(node, "multiple case entry for value %ld", ce->ce_value); } (sh->sh_nrofentries)++; } - return 1; } diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c index 6c70cb11c..bd09e46f0 100644 --- a/lang/m2/comp/chk_expr.c +++ b/lang/m2/comp/chk_expr.c @@ -207,23 +207,24 @@ ChkArr(expp, flags) "index type"); } -#ifdef DEBUG +/*ARGSUSED*/ STATIC int ChkValue(expp) t_node *expp; { +#ifdef DEBUG switch(expp->nd_symb) { case REAL: case STRING: case INTEGER: - return 1; + break; default: crash("(ChkValue)"); } - /*NOTREACHED*/ -} #endif + return 1; +} STATIC int ChkLinkOrName(expp, flags) @@ -430,7 +431,6 @@ MkSet(size) { register arith *s; - size = (size / (int) word_size + 1) * sizeof(arith); s = (arith *) Malloc(size); clear((char *) s , size); s++; @@ -492,7 +492,7 @@ ChkSet(expp) First allocate room for the set. */ - expp->nd_set = MkSet((unsigned)(tp->tp_size)); + expp->nd_set = MkSet(tp->set_sz); /* Now check the elements, one by one */ @@ -1163,7 +1163,7 @@ ChkStandard(expp) } left = getvariable(&arg, edf, - edf->df_value.df_stdname == S_NEW ? D_DEFINED : D_USED); + D_USED|D_DEFINED); expp->nd_type = 0; if (! left) return 0; if (! (left->nd_type->tp_fund == T_POINTER)) { @@ -1395,19 +1395,17 @@ no_desig(expp) } STATIC int -done_before() +add_flags(expp, flags) + t_node *expp; { + expp->nd_def->df_flags |= flags; return 1; } extern int NodeCrash(); int (*ExprChkTable[])() = { -#ifdef DEBUG ChkValue, -#else - done_before, -#endif ChkArr, ChkBinOper, ChkUnOper, @@ -1416,7 +1414,7 @@ int (*ExprChkTable[])() = { ChkExLinkOrName, NodeCrash, ChkSet, - done_before, + add_flags, NodeCrash, ChkExLinkOrName, }; @@ -1431,7 +1429,7 @@ int (*DesigChkTable[])() = { ChkLinkOrName, NodeCrash, no_desig, - done_before, + add_flags, NodeCrash, ChkLinkOrName, }; diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c index 6022b8e9f..37a4c5d8c 100644 --- a/lang/m2/comp/code.c +++ b/lang/m2/comp/code.c @@ -417,6 +417,8 @@ CodeParameters(param, arg) C_loc(left_type->arr_high - left_type->arr_low); } c_loc(0); + } + if (IsConformantArray(tp) || IsVarParam(param) || IsBigParamTp(tp)) { if (left->nd_symb == STRING) { CodeString(left); } @@ -438,10 +440,6 @@ CodeParameters(param, arg) } return; } - if (IsVarParam(param)) { - CodeDAddress(left, 1); - return; - } if (left_type->tp_fund == T_STRING) { CodePString(left, tp); return; diff --git a/lang/m2/comp/cstoper.c b/lang/m2/comp/cstoper.c index fe97c7d64..0ee16fa7d 100644 --- a/lang/m2/comp/cstoper.c +++ b/lang/m2/comp/cstoper.c @@ -371,6 +371,10 @@ cstset(expp) setsize = (unsigned) (expp->nd_right->nd_type->tp_size) / (unsigned) word_size; if (expp->nd_symb == IN) { + /* The setsize must fit in an unsigned, as it is + allocated with Malloc, so we can do the arithmetic + in an unsigned too. + */ unsigned i; assert(expp->nd_left->nd_class == Value); @@ -378,6 +382,10 @@ cstset(expp) expp->nd_left->nd_INT -= expp->nd_right->nd_type->set_low; i = expp->nd_left->nd_INT; expp->nd_class = Value; + /* Careful here; use expp->nd_left->nd_INT to see if + it falls in the range of the set. Do not use i + for this, as i may be truncated. + */ 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)))); @@ -393,7 +401,7 @@ cstset(expp) case '-': /* Set difference */ case '*': /* Set intersection */ case '/': /* Symmetric set difference */ - expp->nd_set = resultset = MkSet(setsize * (unsigned) word_size); + expp->nd_set = resultset = MkSet(expp->nd_type->set_sz); for (j = 0; j < setsize; j++) { switch(expp->nd_symb) { case '+': diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g index 246443b98..654401cf0 100644 --- a/lang/m2/comp/declar.g +++ b/lang/m2/comp/declar.g @@ -402,7 +402,7 @@ CaseLabels(t_type **ptp; register t_node **pnd;) { if (*ptp != 0) { t_type *tp = intorcard(*ptp, - BaseType((*pnd)->nd_type), 0); + BaseType((*pnd)->nd_type)); if (tp) *ptp = tp; ChkCompat(pnd, *ptp, "case label"); } diff --git a/lang/m2/comp/desig.H b/lang/m2/comp/desig.H index 516223e6c..994568180 100644 --- a/lang/m2/comp/desig.H +++ b/lang/m2/comp/desig.H @@ -55,6 +55,7 @@ typedef struct desig t_desig; struct withdesig { struct withdesig *w_next; + int w_flags; /* D_USED|D_DEFINED */ struct scope *w_scope; /* scope in which fields of this record reside */ diff --git a/lang/m2/comp/desig.c b/lang/m2/comp/desig.c index 78748ed18..e52ce1065 100644 --- a/lang/m2/comp/desig.c +++ b/lang/m2/comp/desig.c @@ -514,6 +514,7 @@ CodeFieldDesig(df, ds) /* Found it. Now, act like it was a selection. */ *ds = wds->w_desig; + wds->w_flags |= df->df_flags; assert(ds->dsg_kind == DSG_PFIXED); } @@ -583,10 +584,11 @@ CodeVarDesig(df, ds) */ C_lxa((arith) difflevel); if ((df->df_flags & D_VARPAR) || + IsBigParamTp(df->df_type) || IsConformantArray(df->df_type)) { - /* var parameter or conformant array. - For conformant array's, the address is - passed. + /* var parameter, big parameter, + or conformant array. + The address is passed. */ C_adp(df->var_off); C_loi(pointer_size); @@ -603,7 +605,9 @@ CodeVarDesig(df, ds) /* Now, finally, we have a local variable or a local parameter */ - if ((df->df_flags & D_VARPAR) || IsConformantArray(df->df_type)) { + if ((df->df_flags & D_VARPAR) || + ((df->df_flags & D_VALPAR) && IsBigParamTp(df->df_type)) || + IsConformantArray(df->df_type)) { /* a var parameter; address directly accessible. */ ds->dsg_kind = DSG_PFIXED; diff --git a/lang/m2/comp/enter.c b/lang/m2/comp/enter.c index 6c584acc8..871383732 100644 --- a/lang/m2/comp/enter.c +++ b/lang/m2/comp/enter.c @@ -222,7 +222,7 @@ EnterParamList(ppr, Idlist, type, VARp, off) */ *off += pointer_size + word_size + dword_size; } - else if (VARp == D_VARPAR) { + else if (VARp == D_VARPAR || IsBigParamTp(type)) { *off += pointer_size; } else { diff --git a/lang/m2/comp/main.c b/lang/m2/comp/main.c index 0e30d6883..4db3b49cd 100644 --- a/lang/m2/comp/main.c +++ b/lang/m2/comp/main.c @@ -53,7 +53,7 @@ main(argc, argv) register char **Nargv = &argv[0]; ProgName = *argv++; - DEFPATH = (char **) Malloc(mDEF * sizeof(char *)); + DEFPATH = (char **) Malloc((unsigned)mDEF * sizeof(char *)); while (--argc > 0) { if (**argv == '-') diff --git a/lang/m2/comp/type.H b/lang/m2/comp/type.H index 23f474213..ed2afdc30 100644 --- a/lang/m2/comp/type.H +++ b/lang/m2/comp/type.H @@ -64,14 +64,16 @@ struct record { struct proc { struct paramlist *pr_params; - arith pr_nbpar; + arith pr_nbpar; /* number of bytes parameters accessed */ #define prc_params tp_value.tp_proc.pr_params #define prc_nbpar tp_value.tp_proc.pr_nbpar }; struct set { - arith st_low; + arith st_low; /* lowerbound of subrange type of set */ + unsigned st_sz; /* size of constant set in compiler */ #define set_low tp_value.tp_set.st_low +#define set_sz tp_value.tp_set.st_sz }; struct type { @@ -224,6 +226,7 @@ extern t_type (tpx)) #define IsConstructed(tpx) ((tpx)->tp_fund & T_CONSTRUCTED) #define TooBigForReturnArea(tpx) ((tpx)->tp_size > ret_area_size) +#define IsBigParamTp(tpx) ((tpx)->tp_size > double_size) extern long full_mask[]; extern long max_int[]; diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c index 959fe4189..5842f69cf 100644 --- a/lang/m2/comp/type.c +++ b/lang/m2/comp/type.c @@ -503,7 +503,7 @@ set_type(tp) /* Construct a set type with base type "tp", but first perform some checks */ - arith lb, ub, diff; + arith lb, ub, diff, alloc_size; if (! bounded(tp) || tp->tp_size > word_size) { error("illegal base type for set"); @@ -526,6 +526,12 @@ set_type(tp) tp = construct_type(T_SET, tp); tp->tp_size = WA((diff + 7) >> 3); + alloc_size = (tp->tp_size / word_size + 1) * sizeof(arith); + tp->set_sz = alloc_size; + if (tp->set_sz != alloc_size) { + error("set size too large"); + return error_type; + } tp->set_low = lb; return tp; } diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c index 7485a4149..58a690d49 100644 --- a/lang/m2/comp/walk.c +++ b/lang/m2/comp/walk.c @@ -41,6 +41,7 @@ extern arith NewPtr(); extern arith NewInt(); +extern arith TmpSpace(); extern int proclevel; @@ -61,7 +62,11 @@ static int UseWarnings(); #define NO_EXIT_LABEL ((label) 0) #define RETURN_LABEL ((label) 1) -LblWalkNode(lbl, nd, exit) +#define REACH_FLAG 1 +#define EXIT_FLAG 2 + +int +LblWalkNode(lbl, nd, exit, reach) label lbl, exit; register t_node *nd; { @@ -71,7 +76,7 @@ LblWalkNode(lbl, nd, exit) */ def_ilb(lbl); - WalkNode(nd, exit); + return WalkNode(nd, exit, reach); } static arith tmpprio; @@ -104,6 +109,8 @@ EndPriority() def_ilb(l) label l; { + /* Instruction label definition. Forget about line number. + */ C_df_ilb(l); oldlineno = 0; } @@ -111,7 +118,11 @@ def_ilb(l) DoLineno(nd) register t_node *nd; { - if (! options['L'] && nd->nd_lineno && nd->nd_lineno != oldlineno) { + /* Generate line number information, if necessary. + */ + if (! options['L'] && + nd->nd_lineno && + nd->nd_lineno != oldlineno) { oldlineno = nd->nd_lineno; C_lin((arith) nd->nd_lineno); } @@ -119,6 +130,11 @@ DoLineno(nd) DoFilename(needed) { + /* Generate filename information, when needed. + This routine is called at the generation of a + procedure entry, and after generating a call to + another procedure. + */ static label filename_label = 0; oldlineno = 0; /* always invalidate remembered line number */ @@ -182,6 +198,9 @@ WalkModule(module) C_ine_dlb(data_label, (arith) 0); } else if (! options['R']) { + /* put funny value in BSS, in an attempt to detect + uninitialized variables + */ C_cal("killbss"); } @@ -192,7 +211,7 @@ WalkModule(module) } WalkDefList(sc->sc_def, MkCalls); proclevel++; - WalkNode(module->mod_body, NO_EXIT_LABEL); + WalkNode(module->mod_body, NO_EXIT_LABEL, REACH_FLAG); DO_DEBUG(options['X'], PrNode(module->mod_body, 0)); def_ilb(RETURN_LABEL); EndPriority(); @@ -215,10 +234,13 @@ WalkProcedure(procedure) register t_scope *procscope = procedure->prc_vis->sc_scope; register t_type *tp; register t_param *param; - int too_big = 0; - arith StackAdjustment = 0; - arith retsav = 0; + int too_big = 0; /* returnsize larger than returnarea */ + arith StackAdjustment = 0; /* space for conformant arrays */ + arith retsav = 0; /* temporary space for return value */ arith func_res_size = 0; + int partno = C_getid(); + int partno2 = C_getid(); + int end_reached; /* can fall through ... */ proclevel++; CurrVis = procedure->prc_vis; @@ -242,17 +264,22 @@ WalkProcedure(procedure) /* Generate code for this procedure */ - C_pro_narg(procscope->sc_name); - C_ms_par(procedure->df_type->prc_nbpar + - (too_big ? func_res_size : 0)); TmpOpen(procscope); + C_insertpart(partno2); + C_insertpart(partno); + + text_label = 1; /* label at end of procedure */ + + end_reached = WalkNode(procedure->prc_body, NO_EXIT_LABEL, REACH_FLAG); + + C_beginpart(partno); DoPriority(); /* generate code for filename only when the procedure can be exported, either directly or by taking the address. - This cannot be done if the level is not zero (because in + This cannot be done if the level is bigger than one (because in this case it is a nested procedure). */ - DoFilename(! procscope->sc_level); + DoFilename(procscope->sc_level == 1); /* Generate calls to initialization routines of modules defined within this procedure @@ -261,7 +288,7 @@ WalkProcedure(procedure) /* Make sure that arguments of size < word_size are on a fixed place. - Also make copies of conformant arrays when neccessary. + Also make copies of parameters when neccessary. */ for (param = ParamList(procedure->df_type); param; @@ -273,17 +300,37 @@ WalkProcedure(procedure) if (tp->tp_size < word_size && (int) word_size % (int) tp->tp_size == 0) { C_lol(param->par_def->var_off); - STL(param->par_def->var_off, tp->tp_size); + STL(param->par_def->var_off, + tp->tp_size); + continue; } + if (IsBigParamTp(tp) && + (param->par_def->df_flags & D_DEFINED)){ + /* Value parameter changed in body. + Make a copy + */ + arith tmp = TmpSpace(tp->tp_size, + tp->tp_align); + LOL(param->par_def->var_off, + pointer_size); + C_lal(tmp); + CodeConst(WA(tp->tp_size), + (int)pointer_size); + C_bls(pointer_size); + C_lal(tmp); + STL(param->par_def->var_off, + pointer_size); + } + continue; } - else { + if (param->par_def->df_flags & D_DEFINED) { /* Here, we have to make a copy of the array. We must also remember how much room is reserved for copies, because we have to adjust the stack pointer before a RET is done. This is even more complicated when the procedure returns a value. - Then, the value must be saved (in retval), + Then, the value must be saved, the stack adjusted, the return value pushed again, and then RET */ @@ -295,9 +342,8 @@ WalkProcedure(procedure) needed if the value itself is returned */ - procscope->sc_off -= - func_res_size; - retsav = procscope->sc_off; + retsav= TmpSpace(func_res_size, + 1); } StackAdjustment = NewPtr(); C_lor((arith) 1); @@ -316,12 +362,13 @@ WalkProcedure(procedure) } } } - - text_label = 1; /* label at end of procedure */ - - WalkNode(procedure->prc_body, NO_EXIT_LABEL); + C_endpart(partno); DO_DEBUG(options['X'], PrNode(procedure->prc_body, 0)); - if (func_res_size) { + if ((end_reached & REACH_FLAG) && func_res_size) { + node_warning(procscope->sc_end, + W_ORDINARY, + "function procedure \"%s\" does not always return a value", + procedure->df_idf->id_text); c_loc(M2_NORESULT); C_trp(); C_asp(-func_res_size); @@ -357,10 +404,16 @@ WalkProcedure(procedure) } EndPriority(); C_ret(func_res_size); + C_beginpart(partno2); + C_pro(procscope->sc_name, -procscope->sc_off); + C_ms_par(procedure->df_type->prc_nbpar + + (too_big ? func_res_size : 0)); if (! options['n']) WalkDefList(procscope->sc_def, RegisterMessage); + C_endpart(partno2); C_end(-procscope->sc_off); if (! fit(procscope->sc_off, (int) word_size)) { - node_error(procedure->prc_body, "maximum local byte count exceeded"); + node_error(procedure->prc_body, + "maximum local byte count exceeded"); } TmpClose(); CurrVis = savevis; @@ -409,19 +462,22 @@ MkCalls(df) } } -WalkLink(nd, exit_label) +WalkLink(nd, exit_label, end_reached) register t_node *nd; label exit_label; { /* Walk node "nd", which is a link. + "exit_label" is set to a label number when inside a LOOP. + "end_reached" maintains info about reachability (REACH_FLAG), + and whether an EXIT statement was seen (EXIT_FLAG). */ while (nd && nd->nd_class == Link) { /* statement list */ - WalkNode(nd->nd_left, exit_label); + end_reached = WalkNode(nd->nd_left, exit_label, end_reached); nd = nd->nd_right; } - WalkNode(nd, exit_label); + return WalkNode(nd, exit_label, end_reached); } STATIC @@ -434,7 +490,8 @@ ForLoopVarExpr(nd) CodeCoercion(tp, BaseType(tp)); } -WalkStat(nd, exit_label) +int +WalkStat(nd, exit_label, end_reached) register t_node *nd; label exit_label; { @@ -445,8 +502,11 @@ WalkStat(nd, exit_label) assert(nd->nd_class == Stat); - if (nd->nd_symb == ';') return; + if (nd->nd_symb == ';') return 1; + if (! end_reached & REACH_FLAG) { + node_warning(nd, W_ORDINARY, "statement not reached"); + } DoLineno(nd); options['R'] = (nd->nd_flags & ROPTION); options['A'] = (nd->nd_flags & AOPTION); @@ -467,24 +527,26 @@ WalkStat(nd, exit_label) case IF: { label l1 = ++text_label, l3 = ++text_label; + int end_r; ExpectBool(left, l3, l1); assert(right->nd_symb == THEN); - LblWalkNode(l3, right->nd_left, exit_label); + end_r = LblWalkNode(l3, right->nd_left, exit_label, end_reached); if (right->nd_right) { /* ELSE part */ label l2 = ++text_label; C_bra(l2); - LblWalkNode(l1, right->nd_right, exit_label); + end_reached = end_r | LblWalkNode(l1, right->nd_right, exit_label, end_reached); l1 = l2; } + else end_reached |= end_r; def_ilb(l1); break; } case CASE: - CaseCode(nd, exit_label); + end_reached = CaseCode(nd, exit_label, end_reached); break; case WHILE: @@ -492,10 +554,10 @@ WalkStat(nd, exit_label) exit = ++text_label, dummy = ++text_label; - def_ilb(loop); - ExpectBool(left, dummy, exit); - LblWalkNode(dummy, right, exit_label); - C_bra(loop); + C_bra(dummy); + end_reached |= LblWalkNode(loop, right, exit_label, end_reached); + def_ilb(dummy); + ExpectBool(left, loop, exit); def_ilb(exit); break; } @@ -503,7 +565,7 @@ WalkStat(nd, exit_label) case REPEAT: { label loop = ++text_label, exit = ++text_label; - LblWalkNode(loop, left, exit_label); + end_reached = LblWalkNode(loop, left, exit_label, end_reached); ExpectBool(right, exit, loop); def_ilb(exit); break; @@ -512,7 +574,10 @@ WalkStat(nd, exit_label) case LOOP: { label loop = ++text_label, exit = ++text_label; - LblWalkNode(loop, right, exit); + if (LblWalkNode(loop, right, exit, end_reached) & EXIT_FLAG) { + end_reached &= REACH_FLAG; + } + else end_reached = 0; C_bra(loop); def_ilb(exit); break; @@ -575,7 +640,7 @@ WalkStat(nd, exit_label) ForLoopVarExpr(nd); C_stl(tmp2); - WalkNode(right, exit_label); + end_reached |= WalkNode(right, exit_label, end_reached); C_lol(tmp2); ForLoopVarExpr(nd); C_beq(x); @@ -583,7 +648,7 @@ WalkStat(nd, exit_label) C_trp(); def_ilb(x); } - else WalkNode(right, exit_label); + else end_reached |= WalkNode(right, exit_label, end_reached); nd->nd_def->df_flags &= ~D_FORLOOP; FreeInt(tmp2); if (stepsize) { @@ -601,7 +666,7 @@ WalkStat(nd, exit_label) } } else { - WalkNode(right, exit_label); + end_reached |= WalkNode(right, exit_label, end_reached); nd->nd_def->df_flags &= ~D_FORLOOP; } C_bra(l1); @@ -620,13 +685,14 @@ WalkStat(nd, exit_label) struct withdesig wds; t_desig ds; - if (! WalkDesignator(left, &ds, D_USED|D_DEFINED)) break; + if (! WalkDesignator(left, &ds, D_USED)) break; if (left->nd_type->tp_fund != T_RECORD) { node_error(left, "record variable expected"); break; } wds.w_next = WithDesigs; + wds.w_flags = D_USED; WithDesigs = &wds; wds.w_scope = left->nd_type->rec_scope; CodeAddress(&ds); @@ -642,20 +708,23 @@ WalkStat(nd, exit_label) link.sc_scope = wds.w_scope; link.sc_next = CurrVis; CurrVis = &link; - WalkNode(right, exit_label); + end_reached = WalkNode(right, exit_label, end_reached); CurrVis = link.sc_next; WithDesigs = wds.w_next; FreePtr(ds.dsg_offset); + WalkDesignator(left, &ds, wds.w_flags & (D_USED|D_DEFINED)); break; } case EXIT: assert(exit_label != 0); + if (end_reached & REACH_FLAG) end_reached = EXIT_FLAG; C_bra(exit_label); break; case RETURN: + end_reached &= ~REACH_FLAG; if (right) { if (! ChkExpression(right)) break; /* The type of the return-expression must be @@ -677,6 +746,7 @@ WalkStat(nd, exit_label) default: crash("(WalkStat)"); } + return end_reached; } extern int NodeCrash(); @@ -900,16 +970,18 @@ UseWarnings(df) } switch(df->df_flags & (D_USED|D_DEFINED|D_VALPAR|D_VARPAR)) { case 0: - case D_VALPAR: case D_VARPAR: warning = "never used/assigned"; break; case D_USED|D_VARPAR: - warning = "never assigned, could be value parameter"; + if (df->df_type->tp_fund != T_EQUAL) { + warning = "never assigned, could be value parameter"; + } break; case D_USED: warning = "never assigned"; break; + case D_VALPAR: case D_DEFINED: case D_DEFINED|D_VALPAR: warning = "never used"; @@ -924,7 +996,10 @@ warn: "%s \"%s\" %s", (df->df_flags & D_VALPAR) ? "value parameter" : (df->df_flags & D_VARPAR) ? "variable parameter" : - "identifier", + (df->df_kind == D_VARIABLE) ? "variable" : + (df->df_kind == D_TYPE) ? "type" : + (df->df_kind == D_CONST) ? "constant" : + "procedure", df->df_idf->id_text, warning); } } diff --git a/lang/m2/comp/walk.h b/lang/m2/comp/walk.h index 025fde4fd..0aa7e7598 100644 --- a/lang/m2/comp/walk.h +++ b/lang/m2/comp/walk.h @@ -14,7 +14,7 @@ extern int (*WalkTable[])(); -#define WalkNode(xnd, xlab) (*WalkTable[(xnd)->nd_class])((xnd), (xlab)) +#define WalkNode(xnd, xlab, rch) (*WalkTable[(xnd)->nd_class])((xnd), (xlab),(rch)) extern label text_label; extern label data_label;