New version with different parameter passing mechanism and some
authorceriel <none@none>
Mon, 20 Mar 1989 13:32:06 +0000 (13:32 +0000)
committerceriel <none@none>
Mon, 20 Mar 1989 13:32:06 +0000 (13:32 +0000)
minor fixes

15 files changed:
lang/m2/comp/LLlex.c
lang/m2/comp/Version.c
lang/m2/comp/casestat.C
lang/m2/comp/chk_expr.c
lang/m2/comp/code.c
lang/m2/comp/cstoper.c
lang/m2/comp/declar.g
lang/m2/comp/desig.H
lang/m2/comp/desig.c
lang/m2/comp/enter.c
lang/m2/comp/main.c
lang/m2/comp/type.H
lang/m2/comp/type.c
lang/m2/comp/walk.c
lang/m2/comp/walk.h

index 28379a6..99940f1 100644 (file)
@@ -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;
index 02e1791..63770bc 100644 (file)
@@ -1 +1 @@
-static char Version[] = "ACK Modula-2 compiler Version 0.47";
+static char Version[] = "ACK Modula-2 compiler Version 0.48";
index e21c542..1ffec8c 100644 (file)
@@ -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;
 }
index 6c70cb1..bd09e46 100644 (file)
@@ -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,
 };
index 6022b8e..37a4c5d 100644 (file)
@@ -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;
index fe97c7d..0ee16fa 100644 (file)
@@ -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 '+':
index 246443b..654401c 100644 (file)
@@ -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");
                          }
index 516223e..9945681 100644 (file)
@@ -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
                                */
index 78748ed..e52ce10 100644 (file)
@@ -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;
index 6c584ac..8713837 100644 (file)
@@ -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 {
index 0e30d68..4db3b49 100644 (file)
@@ -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 == '-')
index 23f4742..ed2afdc 100644 (file)
@@ -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[];
index 959fe41..5842f69 100644 (file)
@@ -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;
 }
index 7485a41..58a690d 100644 (file)
@@ -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);
        }
 }
index 025fde4..0aa7e75 100644 (file)
@@ -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;