some fixes and cosmetic changes

diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile
index e739f71..d486ec4 100644 (file)
--- a/lang/m2/comp/Makefile
+++ b/lang/m2/comp/Makefile
@@ -202,12 +202,9 @@ tokenname.o: Lpars.h
 tokenname.o: idf.h
 tokenname.o: tokenname.h
 idf.o: idf.h
-input.o: def.h
 input.o: f_info.h
-input.o: idf.h
 input.o: input.h
 input.o: inputtype.h
-input.o: scope.h
 type.o: LLlex.h
 type.o: chk_expr.h
 type.o: const.h
@@ -265,6 +262,7 @@ typequiv.o: LLlex.h
 typequiv.o: debug.h
 typequiv.o: debugcst.h
 typequiv.o: def.h
+typequiv.o: idf.h
 typequiv.o: node.h
 typequiv.o: type.h
 typequiv.o: warning.h
@@ -394,6 +392,7 @@ char.o: class.h
 Lpars.o: Lpars.h
 casestat.o: LLlex.h
 casestat.o: Lpars.h
+casestat.o: chk_expr.h
 casestat.o: debug.h
 casestat.o: debugcst.h
 casestat.o: density.h
@@ -401,6 +400,7 @@ casestat.o: desig.h
 casestat.o: node.h
 casestat.o: type.h
 casestat.o: walk.h
+tmpvar.o: LLlex.h
 tmpvar.o: debug.h
 tmpvar.o: debugcst.h
 tmpvar.o: def.h

diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c
index bdaf1b1..6529c5f 100644 (file)
--- a/lang/m2/comp/chk_expr.c
+++ b/lang/m2/comp/chk_expr.c
@@ -429,6 +429,7 @@ ChkSet(expp)
        assert(expp->nd_symb == SET);
 
        expp->nd_class = Set;
+       expp->nd_type = error_type;
 
        /* First determine the type of the set
        */
@@ -471,7 +472,6 @@ ChkSet(expp)
                                                expp->nd_set)) {
                        retval = 0;
                }
-               if (nd->nd_left) expp->nd_class = Xset;
                nd = nd->nd_right;
        }
 
@@ -577,7 +577,6 @@ ChkProcCall(expp)
        if (left->nd_type == error_type) {
                /* Just check parameters as if they were value parameters
                */
-               expp->nd_type = error_type;
                while (expp->nd_right) {
                        getarg(&expp, 0, 0, edf);
                }
@@ -622,15 +621,15 @@ ChkFunCall(expp)
 {
        /*      Check a call that must have a result
        */
-       int retval = 1;
 
-       if (!ChkCall(expp)) retval = 0;
+       if (! ChkCall(expp)) return 0;
+
        if (expp->nd_type == 0) {
                node_error(expp, "function call expected");
                expp->nd_type = error_type;
-               retval = 0;
+               return 0;
        }
-       return retval;
+       return 1;
 }
 
 int
@@ -647,7 +646,6 @@ ChkCall(expp)
 
        /* First, get the name of the function or procedure
        */
-       expp->nd_type = error_type;
        if (ChkDesignator(left)) {
                if (IsCast(left)) {
                        /* It was a type cast.
@@ -696,11 +694,7 @@ ResultOfOperation(operator, tp)
        return tp;
 }
 
-STATIC int
-Boolean(operator)
-{
-       return operator == OR || operator == AND;
-}
+#define Boolean(operator) (operator == OR || operator == AND)
 
 STATIC int
 AllowedTypes(operator)
@@ -764,7 +758,7 @@ ChkBinOper(expp)
        /*      Check a binary operation.
        */
        register struct node *left, *right;
-       struct type *tpl, *tpr;
+       register struct type *tpl, *tpr;
        int allowed;
        int retval;
 
@@ -960,6 +954,7 @@ ChkStandard(expp)
 
        assert(left->nd_class == Def);
 
+       expp->nd_type = error_type;
        switch(edf->df_value.df_stdname) {
        case S_ABS:
                if (!(left = getarg(&arg, T_NUMERIC, 0, edf))) return 0;
@@ -1027,7 +1022,6 @@ ChkStandard(expp)
                        MkCoercion(&(arg->nd_left), d2);
                }
                else {
-                       expp->nd_type = error_type;
                        Xerror(left, "unexpected parameter type", edf);
                        break;
                }
@@ -1093,6 +1087,7 @@ ChkStandard(expp)
        node_warning(expp, W_OLDFASHIONED, "NEW and DISPOSE are obsolete");
                        }
                }
+               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);

diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g
index f926f1e..71b1fa3 100644 (file)
--- a/lang/m2/comp/declar.g
+++ b/lang/m2/comp/declar.g
@@ -460,7 +460,8 @@ FormalTypeList(struct type **ptp;)
        ]?
        ')'
        [ ':' qualtype(ptp)
-       ]?
+       |               { *ptp = 0; }
+       ]
                        { *ptp = proc_type(*ptp, pr, parmaddr); }
 ;
 

diff --git a/lang/m2/comp/node.c b/lang/m2/comp/node.c
index dd2bb6e..f4edc9b 100644 (file)
--- a/lang/m2/comp/node.c
+++ b/lang/m2/comp/node.c
@@ -34,7 +34,6 @@ MkNode(class, left, right, token)
        nd->nd_right = right;
        nd->nd_token = *token;
        nd->nd_class = class;
-       nd->nd_type = error_type;
        return nd;
 }
 
@@ -46,7 +45,6 @@ MkLeaf(class, token)
 
        nd->nd_left = nd->nd_right = 0;
        nd->nd_token = *token;
-       nd->nd_type = error_type;
        nd->nd_class = class;
        return nd;
 }

diff --git a/lang/m2/comp/typequiv.c b/lang/m2/comp/typequiv.c
index ad86487..1e0f2c4 100644 (file)
--- a/lang/m2/comp/typequiv.c
+++ b/lang/m2/comp/typequiv.c
@@ -25,6 +25,8 @@
 #include       "node.h"
 #include       "warning.h"
 
+extern char *sprint();
+
 int
 TstTypeEquiv(tp1, tp2)
        struct type *tp1, *tp2;
@@ -193,7 +195,7 @@ TstParCompat(parno, formaltype, VARflag, nd, edf)
        char ebuf1[256];
 
        if (edf) {
-               sprintf(ebuf, "\"%s\", parameter %d: %%s", edf->df_idf->id_text, parno);
+               sprint(ebuf, "\"%s\", parameter %d: %%s", edf->df_idf->id_text, parno);
        }
        else sprint(ebuf, "parameter %d: %%s", parno);
 

diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c
index a1f4e28..312eb9c 100644 (file)
--- a/lang/m2/comp/walk.c
+++ b/lang/m2/comp/walk.c
@@ -704,7 +704,8 @@ node_warning(nd, W_OLDFASHIONED, "compatibility required in FOR statement");
 }
 
 DoAssign(left, right)
-       register struct node *left, *right;
+       register struct node *left;
+       struct node *right;
 {
        /* May we do it in this order (expression first) ???
           The reference manual sais nothing about it, but the book does:
@@ -712,30 +713,29 @@ DoAssign(left, right)
           DAMN THE BOOK!
        */
        register struct desig *dsr;
-       register struct type *rtp, *ltp;
-       struct node *rht = right;
+       register struct type *tp;
 
        if (! (ChkExpression(right) & ChkVariable(left))) return;
-       rtp = right->nd_type;
-       ltp = left->nd_type;
+       tp = left->nd_type;
 
-       if (right->nd_symb == STRING) TryToString(right, ltp);
+       if (right->nd_symb == STRING) TryToString(right, tp);
 
-       if (! ChkAssCompat(&rht, ltp, "assignment")) {
+       if (! ChkAssCompat(&right, tp, "assignment")) {
                return;
        }
        dsr = new_desig();
 
 #define StackNeededFor(ds)     ((ds)->dsg_kind == DSG_PLOADED \
                                  || (ds)->dsg_kind == DSG_INDEXED)
-       CodeExpr(rht, dsr, NO_LABEL, NO_LABEL);
-       if (complex(rtp)) {
+       CodeExpr(right, dsr, NO_LABEL, NO_LABEL);
+       tp = right->nd_type;
+       if (complex(tp)) {
                if (StackNeededFor(dsr)) CodeAddress(dsr);
        }
        else {
-               CodeValue(dsr, rtp);
+               CodeValue(dsr, tp);
        }
-       CodeMove(dsr, left, rtp);
+       CodeMove(dsr, left, tp);
        free_desig(dsr);
 }