some minor changes and a fix in pointer arithmetic

diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c
index 88c1a7f..47928a6 100644 (file)
--- a/lang/m2/comp/chk_expr.c
+++ b/lang/m2/comp/chk_expr.c
@@ -1021,7 +1021,6 @@ ChkStandard(expp)
        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);
@@ -1030,17 +1029,19 @@ ChkStandard(expp)
        switch(edf->df_value.df_stdname) {
        case S_ABS:
                if (!(left = getarg(&arg, T_NUMERIC, 0, edf))) return 0;
-               basetype = BaseType(left->nd_type);
-               MkCoercion(&(arg->nd_left), basetype);
-               left = arg->nd_left;
-               expp->nd_type = left->nd_type;
-               if (left->nd_class == Value &&
-                   expp->nd_type->tp_fund != T_REAL) {
-                       cstcall(expp, S_ABS);
-               }
-               else if (basetype->tp_fund != T_INTEGER &&
-                        basetype->tp_fund != T_REAL) {
+               expp->nd_type = BaseType(left->nd_type);
+               MkCoercion(&(arg->nd_left), expp->nd_type);
+               switch(expp->nd_type->tp_fund) {
+               case T_REAL:
+                       break;
+               case T_INTEGER:
+                       if (arg->nd_left->nd_class == Value) {
+                               cstcall(expp,S_ABS);
+                       }
+                       break;
+               default:
                        free_it = 1;
+                       break;
                }
                break;
 
@@ -1050,13 +1051,6 @@ ChkStandard(expp)
                if (left->nd_class == Value) cstcall(expp, S_CAP);
                break;
 
-       case S_CHR:
-               expp->nd_type = char_type;
-               if (!(left = getarg(&arg, T_INTORCARD, 0, edf))) return 0;
-               MkCoercion(&(arg->nd_left), char_type);
-               free_it = 1;
-               break;
-
        case S_FLOATD:
        case S_FLOAT:
                if (! getarg(&arg, T_INTORCARD, 0, edf)) return 0;
@@ -1152,9 +1146,13 @@ ChkStandard(expp)
                break;
 
        case S_ORD:
-               if (! getarg(&arg, T_DISCRETE, 0, edf)) return 0;
-               MkCoercion(&(arg->nd_left), card_type);
-               free_it = 1;
+               if (! (left = getarg(&arg, T_NOSUB, 0, edf))) return 0;
+               MkCoercion(&(arg->nd_left), BaseType(left->nd_type));
+               expp->nd_type = card_type;
+               if (arg->nd_left->nd_class == Value) {
+                       arg->nd_left->nd_type = card_type;
+                       free_it = 1;
+               }
                break;
 
 #ifndef STRICT_3RD_ED
@@ -1220,17 +1218,15 @@ ChkStandard(expp)
 
        case S_TRUNCD:
        case S_TRUNC:
-               expp->nd_type = card_type;
-               if (edf->df_value.df_stdname == S_TRUNCD) {
-                       expp->nd_type = longint_type;
-               }
                if (! getarg(&arg, T_REAL, 0, edf)) return 0;
-               MkCoercion(&(arg->nd_left), expp->nd_type);
+               MkCoercion(&(arg->nd_left),
+                          edf->df_value.df_stdname == S_TRUNCD ?
+                               longint_type : card_type);
                free_it = 1;
                break;
 
        case S_VAL:
-               if (!(left = getname(&arg, D_ISTYPE, T_DISCRETE, edf))) {
+               if (!(left = getname(&arg, D_ISTYPE, T_NOSUB, edf))) {
                        return 0;
                }
                expp->nd_type = left->nd_def->df_type;
@@ -1238,9 +1234,16 @@ ChkStandard(expp)
                arg->nd_right = 0;
                FreeNode(arg);
                arg = expp;
-               if (!(left = getarg(&arg, T_INTORCARD, 0, edf))) return 0;
-               MkCoercion(&(arg->nd_left), expp->nd_type);
-               free_it = 1;
+               /* fall through */
+       case S_CHR:
+               if (! getarg(&arg, T_CARDINAL, 0, edf)) return 0;
+               if (edf->df_value.df_stdname == S_CHR) {
+                       expp->nd_type = char_type;
+               }
+               if (expp->nd_type != int_type) {
+                       MkCoercion(&(arg->nd_left), expp->nd_type);
+                       free_it = 1;
+               }
                break;
 
        case S_ADR:
@@ -1344,10 +1347,16 @@ ChkCast(expp)
                  df);
        }
 
+       expp->nd_right->nd_left = 0;
+       FreeLR(expp);
        if (arg->nd_class == Value) {
-               expp->nd_right->nd_left = 0;
-               FreeLR(expp);
                *expp = *arg;
+               free_node(arg);
+       }
+       else {
+               expp->nd_symb = CAST;
+               expp->nd_class = Uoper;
+               expp->nd_right = arg;
        }
        expp->nd_type = lefttype;
 

diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c
index 15f5211..e9d2167 100644 (file)
--- a/lang/m2/comp/code.c
+++ b/lang/m2/comp/code.c
@@ -319,15 +319,6 @@ CodeCall(nd)
                return;
        }       
 
-       if (IsCast(left)) {
-               /* it was just a cast. Simply ignore it
-               */
-               CodePExpr(right->nd_left);
-               *nd = *(right->nd_left);
-               nd->nd_type = left->nd_def->df_type;
-               return;
-       }
-
        assert(IsProcCall(left));
 
        if (right) {
@@ -501,6 +492,11 @@ CodeStd(nd)
        }
 
        switch(std) {
+       case S_ORD:
+       case S_VAL:
+               CodePExpr(left);
+               break;
+
        case S_ABS:
                CodePExpr(left);
                if (tp->tp_fund == T_INTEGER) {
@@ -517,8 +513,7 @@ CodeStd(nd)
 
        case S_CAP:
                CodePExpr(left);
-               c_loc(0137);    /* ASCII assumed */
-               C_and(word_size);
+               C_cal("cap");
                break;
 
        case S_HIGH:
@@ -706,15 +701,17 @@ CodeOper(expr, true_label, false_label)
                case T_REAL:
                        C_sbf(tp->tp_size);
                        break;
-               case T_CARDINAL:
+               case T_POINTER:
+               case T_EQUAL:
                        if (rightop->nd_type == address_type) {
-                               C_sbs(pointer_size);
+                               C_sbs(tp->tp_size);
                                break;
                        }
-                       /* fall through */
-               case T_POINTER:
-               case T_EQUAL:
+                       C_ngi(rightop->nd_type->tp_size);
+                       C_ads(rightop->nd_type->tp_size);
+                       break;
                case T_INTORCARD:
+               case T_CARDINAL:
                        subu(tp->tp_size);
                        break;
                case T_SET:
@@ -994,6 +991,8 @@ CodeUoper(nd)
                CodeCoercion(nd->nd_right->nd_type, tp);
                RangeCheck(tp, nd->nd_right->nd_type);
                break;
+       case CAST:
+               break;
        default:
                crash("Bad unary operator");
        }

diff --git a/lang/m2/comp/tokenname.c b/lang/m2/comp/tokenname.c
index 7790767..f1a0d1c 100644 (file)
--- a/lang/m2/comp/tokenname.c
+++ b/lang/m2/comp/tokenname.c
@@ -86,6 +86,7 @@ struct tokenname tkidf[] =    {       /* names of the identifier tokens */
 struct tokenname tkinternal[] = {      /* internal keywords    */
        {PROGRAM, ""},
        {COERCION, ""},
+       {CAST, ""},
        {0, "0"}
 };
 

diff --git a/lang/m2/comp/type.H b/lang/m2/comp/type.H
index 4ff1930..fc626a7 100644 (file)
--- a/lang/m2/comp/type.H
+++ b/lang/m2/comp/type.H
@@ -95,6 +95,7 @@ struct type   {
 #define T_ARRAY                0x2000
 #define T_STRING       0x4000
 #define T_INTORCARD    (T_INTEGER|T_CARDINAL)
+#define T_NOSUB                (T_INTORCARD|T_ENUMERATION|T_CHAR)
 #define T_NUMERIC      (T_INTORCARD|T_REAL)
 #define T_INDEX                (T_ENUMERATION|T_CHAR|T_SUBRANGE)
 #define T_DISCRETE     (T_INDEX|T_INTORCARD)