better compatibility between CARDINAL and ADDRESS

diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c
index 1d8b93d..eaf8f03 100644 (file)
--- a/lang/m2/comp/chk_expr.c
+++ b/lang/m2/comp/chk_expr.c
@@ -28,11 +28,11 @@ static char *RcsId = "$Header$";
 extern char *symbol2str();
 
 int
-chk_variable(expp)
+ChkVariable(expp)
        register struct node *expp;
 {
 
-       if (! chk_designator(expp)) return 0;
+       if (! ChkDesignator(expp)) return 0;
 
        if (expp->nd_class == Def &&
            !(expp->nd_def->df_kind & (D_FIELD|D_VARIABLE))) {
@@ -44,7 +44,7 @@ chk_variable(expp)
 }
 
 STATIC int
-chk_arrow(expp)
+ChkArrow(expp)
        register struct node *expp;
 {
        register struct type *tp;
@@ -54,7 +54,7 @@ chk_arrow(expp)
 
        expp->nd_type = error_type;
 
-       if (! chk_variable(expp->nd_right)) return 0;
+       if (! ChkVariable(expp->nd_right)) return 0;
 
        tp = expp->nd_right->nd_type;
 
@@ -69,7 +69,7 @@ chk_arrow(expp)
 }
 
 STATIC int
-chk_arr(expp)
+ChkArr(expp)
        register struct node *expp;
 {
        register struct type *tpl, *tpr;
@@ -80,9 +80,9 @@ chk_arr(expp)
        expp->nd_type = error_type;
 
        if ( 
-            !chk_variable(expp->nd_left)
+            !ChkVariable(expp->nd_left)
           ||
-            !chk_expr(expp->nd_right)
+            !ChkExpression(expp->nd_right)
           ||
             expp->nd_left->nd_type == error_type
           )    return 0;
@@ -111,7 +111,7 @@ chk_arr(expp)
 }
 
 STATIC int
-chk_value(expp)
+ChkValue(expp)
        struct node *expp;
 {
        switch(expp->nd_symb) {
@@ -121,13 +121,13 @@ chk_value(expp)
                return 1;
 
        default:
-               crash("(chk_value)");
+               crash("(ChkValue)");
        }
        /*NOTREACHED*/
 }
 
 STATIC int
-chk_linkorname(expp)
+ChkLinkOrName(expp)
        register struct node *expp;
 {
        register struct def *df;
@@ -142,7 +142,7 @@ chk_linkorname(expp)
 
                assert(expp->nd_symb == '.');
 
-               if (! chk_designator(left)) return 0;
+               if (! ChkDesignator(left)) return 0;
 
                if (left->nd_type->tp_fund != T_RECORD ||
                    (left->nd_class == Def &&
@@ -204,12 +204,12 @@ df->df_idf->id_text);
 }
 
 STATIC int
-chk_ex_linkorname(expp)
+ChkExLinkOrName(expp)
        register struct node *expp;
 {
        register struct def *df;
 
-       if (! chk_linkorname(expp)) return 0;
+       if (! ChkLinkOrName(expp)) return 0;
        if (expp->nd_class != Def) return 1;
        df = expp->nd_def;
 
@@ -237,7 +237,7 @@ STATIC int
 RemoveSet(set)
        arith **set;
 {
-       /*      This routine is only used for error exits of chk_el.
+       /*      This routine is only used for error exits of ChkElement.
                It frees the set indicated by "set", and returns 0.
        */
        if (*set) {
@@ -248,7 +248,7 @@ RemoveSet(set)
 }
 
 STATIC int
-chk_el(expp, tp, set)
+ChkElement(expp, tp, set)
        register struct node *expp;
        register struct type *tp;
        arith **set;
@@ -265,7 +265,7 @@ chk_el(expp, tp, set)
                /* { ... , expr1 .. expr2,  ... }
                   First check expr1 and expr2, and try to compute them.
                */
-               if (!chk_el(left, tp, set) || !chk_el(right, tp, set)) {
+               if (!ChkElement(left, tp, set) || !ChkElement(right, tp, set)) {
                        return 0;
                }
 
@@ -295,7 +295,7 @@ node_error(expp, "lower bound exceeds upper bound in range");
 
        /* Here, a single element is checked
        */
-       if (!chk_expr(expp)) {
+       if (!ChkExpression(expp)) {
                return RemoveSet(set);
        }
 
@@ -326,7 +326,7 @@ node_error(expp, "lower bound exceeds upper bound in range");
 }
 
 STATIC int
-chk_set(expp)
+ChkSet(expp)
        register struct node *expp;
 {
        /*      Check the legality of a SET aggregate, and try to evaluate it
@@ -345,7 +345,7 @@ chk_set(expp)
        if (nd = expp->nd_left) {
                /* A type was given. Check it out
                */
-               if (! chk_designator(nd)) return 0;
+               if (! ChkDesignator(nd)) return 0;
 
                assert(nd->nd_class == Def);
                df = nd->nd_def;
@@ -383,7 +383,7 @@ node_error(expp, "specifier does not represent a set type");
        while (nd) {
                assert(nd->nd_class == Link && nd->nd_symb == ',');
 
-               if (!chk_el(nd->nd_left, ElementType(tp), &set)) return 0;
+               if (!ChkElement(nd->nd_left, ElementType(tp), &set)) return 0;
                nd = nd->nd_right;
        }
 
@@ -426,8 +426,8 @@ getarg(argp, bases, designator)
        arg = arg->nd_right;
        left = arg->nd_left;
 
-       if ((!designator && !chk_expr(left)) ||
-           (designator && !chk_variable(left))) {
+       if ((!designator && !ChkExpression(left)) ||
+           (designator && !ChkVariable(left))) {
                return 0;
        }
 
@@ -454,7 +454,7 @@ getname(argp, kinds)
        }
 
        arg = arg->nd_right;
-       if (! chk_designator(arg->nd_left)) return 0;
+       if (! ChkDesignator(arg->nd_left)) return 0;
 
        if (arg->nd_left->nd_class != Def && arg->nd_left->nd_class != LinkDef) {
                node_error(arg, "identifier expected");
@@ -471,7 +471,7 @@ getname(argp, kinds)
 }
 
 STATIC int
-chk_proccall(expp)
+ChkProcCall(expp)
        register struct node *expp;
 {
        /*      Check a procedure call
@@ -507,7 +507,7 @@ node_error(left, "type incompatibility in parameter");
 }
 
 int
-chk_call(expp)
+ChkCall(expp)
        register struct node *expp;
 {
        /*      Check something that looks like a procedure or function call.
@@ -515,19 +515,19 @@ chk_call(expp)
                it may also be a cast or a standard procedure call.
        */
        register struct node *left;
-       STATIC int chk_std();
-       STATIC int chk_cast();
+       STATIC int ChkStandard();
+       STATIC int ChkCast();
 
        /* First, get the name of the function or procedure
        */
        expp->nd_type = error_type;
        left = expp->nd_left;
-       if (! chk_designator(left)) return 0;
+       if (! ChkDesignator(left)) return 0;
 
        if (IsCast(left)) {
                /* It was a type cast. This is of course not portable.
                */
-               return chk_cast(expp, left);
+               return ChkCast(expp, left);
        }
 
        if (IsProcCall(left)) {
@@ -537,12 +537,12 @@ chk_call(expp)
                if (left->nd_type == std_type) {
                        /* A standard procedure
                        */
-                       return chk_std(expp, left);
+                       return ChkStandard(expp, left);
                }
                /* Here, we have found a real procedure call. The left hand
                   side may also represent a procedure variable.
                */
-               return chk_proccall(expp);
+               return ChkProcCall(expp);
        }
 
        node_error(left, "procedure, type, or function expected");
@@ -606,7 +606,7 @@ AllowedTypes(operator)
 }
 
 STATIC int
-chk_address(tpl, tpr)
+ChkAddress(tpl, tpr)
        register struct type *tpl, *tpr;
 {
        
@@ -622,7 +622,7 @@ chk_address(tpl, tpr)
 }
 
 STATIC int
-chk_oper(expp)
+ChkBinOper(expp)
        register struct node *expp;
 {
        /*      Check a binary operation.
@@ -634,7 +634,7 @@ chk_oper(expp)
        left = expp->nd_left;
        right = expp->nd_right;
 
-       if (!chk_expr(left) || !chk_expr(right)) return 0;
+       if (!ChkExpression(left) || !ChkExpression(right)) return 0;
 
        tpl = BaseType(left->nd_type);
        tpr = BaseType(right->nd_type);
@@ -686,10 +686,11 @@ node_error(expp, "IN operator: type of LHS not compatible with element type of R
            (tpl != bool_type && Boolean(expp->nd_symb))) {
                if (!(tpl->tp_fund == T_POINTER &&
                      (T_CARDINAL & allowed) &&
-                     chk_address(tpl, tpr))) {
+                     ChkAddress(tpl, tpr))) {
 node_error(expp,"operator \"%s\": illegal operand type(s)", symbol2str(expp->nd_symb));
                        return 0;
                }
+               expp->nd_type = card_type;
        }
 
        if (tpl->tp_fund == T_SET) {
@@ -706,7 +707,7 @@ node_error(expp,"operator \"%s\": illegal operand type(s)", symbol2str(expp->nd_
 }
 
 STATIC int
-chk_uoper(expp)
+ChkUnOper(expp)
        register struct node *expp;
 {
        /*      Check an unary operation.
@@ -714,9 +715,10 @@ chk_uoper(expp)
        register struct node *right = expp->nd_right;
        register struct type *tpr;
 
-       if (! chk_expr(right)) return 0;
+       if (! ChkExpression(right)) return 0;
 
        tpr = BaseType(right->nd_type);
+       if (tpr == address_type) tpr = card_type;
        expp->nd_type = tpr;
 
        switch(expp->nd_symb) {
@@ -766,7 +768,7 @@ chk_uoper(expp)
                break;
 
        default:
-               crash("chk_uoper");
+               crash("ChkUnOper");
        }
        node_error(expp, "illegal operand for unary operator \"%s\"",
                        symbol2str(expp->nd_symb));
@@ -785,14 +787,14 @@ getvariable(argp)
                return 0;
        }
 
-       if (! chk_variable(arg->nd_left)) return 0;
+       if (! ChkVariable(arg->nd_left)) return 0;
 
        *argp = arg;
        return arg->nd_left;
 }
 
 STATIC int
-chk_std(expp, left)
+ChkStandard(expp, left)
        register struct node *expp, *left;
 {
        /*      Check a call of a standard procedure or function
@@ -909,7 +911,7 @@ chk_std(expp, left)
                                                "ALLOCATE" : "DEALLOCATE", 0);
                        expp->nd_left = MkLeaf(Name, &dt);
                }
-               return chk_call(expp);
+               return ChkCall(expp);
 
        case S_TSIZE:   /* ??? */
        case S_SIZE:
@@ -989,7 +991,7 @@ node_error(arg, "EXCL and INCL expect a SET parameter");
                }
 
        default:
-               crash("(chk_std)");
+               crash("(ChkStandard)");
        }
 
        if (arg->nd_right) {
@@ -1001,7 +1003,7 @@ node_error(arg, "EXCL and INCL expect a SET parameter");
 }
 
 STATIC int
-chk_cast(expp, left)
+ChkCast(expp, left)
        register struct node *expp, *left;
 {
        /*      Check a cast and perform it if the argument is constant.
@@ -1019,7 +1021,7 @@ node_error(expp, "only one parameter expected in type cast");
        }
 
        arg = arg->nd_left;
-       if (! chk_expr(arg)) return 0;
+       if (! ChkExpression(arg)) return 0;
 
        if (arg->nd_type->tp_size != left->nd_type->tp_size &&
            (arg->nd_type->tp_size > word_size ||
@@ -1078,33 +1080,33 @@ done_before(expp)
 extern int     NodeCrash();
 
 int (*ExprChkTable[])() = {
-       chk_value,
-       chk_arr,
-       chk_oper,
-       chk_uoper,
-       chk_arrow,
-       chk_call,
-       chk_ex_linkorname,
+       ChkValue,
+       ChkArr,
+       ChkBinOper,
+       ChkUnOper,
+       ChkArrow,
+       ChkCall,
+       ChkExLinkOrName,
        NodeCrash,
-       chk_set,
+       ChkSet,
        NodeCrash,
        NodeCrash,
-       chk_ex_linkorname,
+       ChkExLinkOrName,
        NodeCrash
 };
 
 int (*DesigChkTable[])() = {
-       chk_value,
-       chk_arr,
+       ChkValue,
+       ChkArr,
        no_desig,
        no_desig,
-       chk_arrow,
+       ChkArrow,
        no_desig,
-       chk_linkorname,
+       ChkLinkOrName,
        NodeCrash,
        no_desig,
        done_before,
        NodeCrash,
-       chk_linkorname,
+       ChkLinkOrName,
        done_before
 };

diff --git a/lang/m2/comp/chk_expr.h b/lang/m2/comp/chk_expr.h
index d24ed64..288bb71 100644 (file)
--- a/lang/m2/comp/chk_expr.h
+++ b/lang/m2/comp/chk_expr.h
@@ -9,5 +9,5 @@ extern int      (*DesigChkTable[])();   /* table of designator checking
                                           functions, indexed by node class
                                        */
 
-#define        chk_expr(expp)  ((*ExprChkTable[(expp)->nd_class])(expp))
-#define chk_designator(expp)   ((*DesigChkTable[(expp)->nd_class])(expp))
+#define        ChkExpression(expp)     ((*ExprChkTable[(expp)->nd_class])(expp))
+#define ChkDesignator(expp)    ((*DesigChkTable[(expp)->nd_class])(expp))

diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g
index 53fb466..408fd91 100644 (file)
--- a/lang/m2/comp/declar.g
+++ b/lang/m2/comp/declar.g
@@ -341,7 +341,7 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
                           the type
                        */
                                { warning("Old fashioned Modula-2 syntax!");
-                                 if (chk_designator(nd) &&
+                                 if (ChkDesignator(nd) &&
                                      (nd->nd_class != Def ||
                                       !(nd->nd_def->df_kind&(D_ERROR|D_ISTYPE)) ||
                                       !nd->nd_def->df_type)) {

diff --git a/lang/m2/comp/expression.g b/lang/m2/comp/expression.g
index ca3961f..18a04cb 100644 (file)
--- a/lang/m2/comp/expression.g
+++ b/lang/m2/comp/expression.g
@@ -48,7 +48,7 @@ qualident(int types;
                { if (types) {
                        df = ill_df;
 
-                       if (chk_designator(nd)) {
+                       if (ChkDesignator(nd)) {
                            if (nd->nd_class != Def) {
                                node_error(nd, "%s expected", str);
                            }
@@ -99,7 +99,7 @@ ConstExpression(struct node **pnd;):
         */
                { DO_DEBUG(options['X'], print("CONSTANT EXPRESSION\n"));
                  DO_DEBUG(options['X'], PrNode(*pnd, 0));
-                 if (chk_expr(*pnd) &&
+                 if (ChkExpression(*pnd) &&
                      ((*pnd)->nd_class != Set && (*pnd)->nd_class != Value)) {
                        error("Constant expression expected");
                  }

diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c
index 434c0c2..610bc9f 100644 (file)
--- a/lang/m2/comp/type.c
+++ b/lang/m2/comp/type.c
@@ -154,6 +154,10 @@ InitTypes()
                fatal("integer size not equal to word size");
        }
 
+       if (int_size != pointer_size) {
+               fatal("cardinal size not equal to pointer size");
+       }
+
        if (long_size < int_size || long_size % word_size != 0) {
                fatal("illegal long integer size");
        }

diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c
index 68e60c2..d725742 100644 (file)
--- a/lang/m2/comp/walk.c
+++ b/lang/m2/comp/walk.c
@@ -256,7 +256,7 @@ WalkCall(nd)
        assert(nd->nd_class == Call);
 
        if (! options['L']) C_lin((arith) nd->nd_lineno);
-       if (chk_call(nd)) {
+       if (ChkCall(nd)) {
                if (nd->nd_type != 0) {
                        node_error(nd, "procedure call expected");
                        return;
@@ -472,7 +472,7 @@ ExpectBool(nd, true_label, false_label)
        */
        struct desig ds;
 
-       if (!chk_expr(nd)) return;
+       if (!ChkExpression(nd)) return;
 
        if (nd->nd_type != bool_type && nd->nd_type != error_type) {
                node_error(nd, "boolean expression expected");
@@ -488,7 +488,7 @@ WalkExpr(nd)
        /*      Check an expression and generate code for it
        */
 
-       if (! chk_expr(nd)) return;
+       if (! ChkExpression(nd)) return;
 
        CodePExpr(nd);
 }
@@ -500,7 +500,7 @@ WalkDesignator(nd, ds)
        /*      Check designator and generate code for it
        */
 
-       if (! chk_variable(nd)) return;
+       if (! ChkVariable(nd)) return;
 
        *ds = InitDesig;
        CodeDesig(nd, ds);
@@ -515,9 +515,9 @@ DoForInit(nd, left)
        nd->nd_class = Name;
        nd->nd_symb = IDENT;
 
-       if (! chk_variable(nd) ||
-           ! chk_expr(left->nd_left) ||
-           ! chk_expr(left->nd_right)) return 0;
+       if (! ChkVariable(nd) ||
+           ! ChkExpression(left->nd_left) ||
+           ! ChkExpression(left->nd_right)) return 0;
 
        df = nd->nd_def;
        if (df->df_kind == D_FIELD) {
@@ -543,16 +543,16 @@ DoForInit(nd, left)
                }
        }
 
-       if (nd->nd_type->tp_size > word_size ||
-           !(nd->nd_type->tp_fund & T_DISCRETE)) {
+       if (df->df_type->tp_size > word_size ||
+           !(df->df_type->tp_fund & T_DISCRETE)) {
                node_error(nd, "illegal type of FOR loop variable");
                return 0;
        }
 
-       if (!TstCompat(nd->nd_type, left->nd_left->nd_type) ||
-           !TstCompat(nd->nd_type, left->nd_right->nd_type)) {
-               if (!TstAssCompat(nd->nd_type, left->nd_left->nd_type) ||
-                   !TstAssCompat(nd->nd_type, left->nd_right->nd_type)) {
+       if (!TstCompat(df->df_type, left->nd_left->nd_type) ||
+           !TstCompat(df->df_type, left->nd_right->nd_type)) {
+               if (!TstAssCompat(df->df_type, left->nd_left->nd_type) ||
+                   !TstAssCompat(df->df_type, left->nd_right->nd_type)) {
                        node_error(nd, "type incompatibility in FOR statement");
                        return 0;
                }
@@ -571,8 +571,8 @@ DoAssign(nd, left, right)
        /* May we do it in this order (expression first) ??? */
        struct desig dsl, dsr;
 
-       if (!chk_expr(right)) return;
-       if (! chk_variable(left)) return;
+       if (!ChkExpression(right)) return;
+       if (! ChkVariable(left)) return;
        TryToString(right, left->nd_type);
        dsr = InitDesig;
        CodeExpr(right, &dsr, NO_LABEL, NO_LABEL);