Added LONGCARD as a local extension

diff --git a/lang/m2/comp/LLlex.c b/lang/m2/comp/LLlex.c
index 15fd0f3..1450618 100644 (file)
--- a/lang/m2/comp/LLlex.c
+++ b/lang/m2/comp/LLlex.c
@@ -529,12 +529,30 @@ lexwarning(W_ORDINARY, "character constant out of range");
                                        return tk->tk_symb = INTEGER;
                                }
                                if (ch == 'D' && base == 10) {
+                                   if (options['l']) {
+                                       /* Local extension: LONGCARD exists,
+                                          so internally also longintorcard_type
+                                          exists.
+                                       */
+                                       toktype = longcard_type;
+                                       if (ovfl == 0 && tk->TOK_INT >= 0 &&
+                                           tk->TOK_INT<=max_int[(int)long_size]) {
+                                           toktype = longintorcard_type;
+                                       }
+                                       else if (! chk_bounds(tk->TOK_INT,
+                                                     full_mask[(int)long_size],
+                                                     T_CARDINAL)) {
+                                           ovfl = 1;
+                                       }
+                                   }
+                                   else {
                                        if (ovfl != 0 ||
                                            tk->TOK_INT > max_int[(int)long_size] ||
                                            tk->TOK_INT < 0) {
                                                ovfl = 1;
                                        }
                                        toktype = longint_type;
+                                   }
                                }
                                else if (ovfl == 0 && tk->TOK_INT >= 0 &&
                                         tk->TOK_INT<=max_int[(int)int_size]) {
@@ -543,7 +561,7 @@ lexwarning(W_ORDINARY, "character constant out of range");
                                else if (! chk_bounds(tk->TOK_INT,
                                                      full_mask[(int)int_size],
                                                      T_CARDINAL)) {
-                                                       ovfl = 1;
+                                       ovfl = 1;
                                }
                                if (ovfl)
 lexwarning(W_ORDINARY, "overflow in constant");

diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c
index 0dd7f11..25f0f2d 100644 (file)
--- a/lang/m2/comp/chk_expr.c
+++ b/lang/m2/comp/chk_expr.c
@@ -921,10 +921,10 @@ ChkBinOper(expp)
        tpr = BaseType(exp->nd_RIGHT->nd_type);
 
        if (intorcard(tpl, tpr) != 0) {
-               if (tpl == intorcard_type) {
+               if (tpl->tp_fund == T_INTORCARD) {
                         exp->nd_LEFT->nd_type = tpl = tpr;
                }
-               if (tpr == intorcard_type) {
+               if (tpr->tp_fund == T_INTORCARD) {
                        exp->nd_RIGHT->nd_type = tpr = tpl;
                }
        }
@@ -1052,6 +1052,9 @@ ChkUnOper(expp)
                        if (tpr == intorcard_type) {
                                exp->nd_type = int_type;
                        }
+                       else if (tpr == longintorcard_type) {
+                               exp->nd_type = longint_type;
+                       }
                        if (right->nd_class == Value) {
                                cstunary(expp);
                        }
@@ -1166,7 +1169,7 @@ ChkStandard(expp)
        case S_SHORT:
        case S_LONG: {
                t_type *tp;
-               t_type *s1, *s2, *d1, *d2;
+               t_type *s1, *s2, *s3, *d1, *d2, *d3;
 
                if (!(arg = getarg(&arglink, 0, 0, edf))) {
                        return 0;
@@ -1178,12 +1181,16 @@ ChkStandard(expp)
                        d1 = int_type;
                        s2 = longreal_type;
                        d2 = real_type;
+                       s3 = longcard_type;
+                       d3 = card_type;
                }
                else {
                        d1 = longint_type;
                        s1 = int_type;
                        d2 = longreal_type;
                        s2 = real_type;
+                       d3 = longcard_type;
+                       s3 = card_type;
                }
 
                if (tp == s1) {
@@ -1192,6 +1199,9 @@ ChkStandard(expp)
                else if (tp == s2) {
                        MkCoercion(&(arglink->nd_LEFT), d2);
                }
+               else if (options['l'] && tp == s3) {
+                       MkCoercion(&(arglink->nd_LEFT), d3);
+               }
                else {
                        df_error(arg, "unexpected parameter type", edf);
                        break;
@@ -1330,7 +1340,8 @@ ChkStandard(expp)
                if (! getarg(&arglink, T_REAL, 0, edf)) return 0;
                MkCoercion(&(arglink->nd_LEFT),
                           edf->df_value.df_stdname == S_TRUNCD ?
-                               longint_type : card_type);
+                               options['l'] ? longcard_type : longint_type
+                                       : card_type);
                free_it = 1;
                break;
 

diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c
index 2bc8f75..4916f12 100644 (file)
--- a/lang/m2/comp/code.c
+++ b/lang/m2/comp/code.c
@@ -687,8 +687,8 @@ RangeCheck(tpl, tpr)
                return;
        }
        tpr = BaseType(tpr);
-       if ((tpl->tp_fund == T_INTEGER && tpr == card_type) ||
-            (tpr->tp_fund == T_INTEGER && tpl == card_type)) {
+       if ((tpl->tp_fund == T_INTEGER && tpr->tp_fund == T_CARDINAL) ||
+            (tpr->tp_fund == T_INTEGER && tpl->tp_fund == T_CARDINAL)) {
                label lb = ++text_label;
 
                C_dup(tpr->tp_size);
@@ -865,7 +865,7 @@ CodeOper(expr, true_label, false_label)
 
                Operands(expr);
                tp = BaseType(leftop->nd_type);
-               if (tp == intorcard_type) tp = BaseType(rightop->nd_type);
+               if (tp->tp_fund == T_INTORCARD) tp = BaseType(rightop->nd_type);
                size = tp->tp_size;
                switch (tp->tp_fund)    {
                case T_INTEGER:

diff --git a/lang/m2/comp/cstoper.c b/lang/m2/comp/cstoper.c
index 2ee060b..fafb560 100644 (file)
--- a/lang/m2/comp/cstoper.c
+++ b/lang/m2/comp/cstoper.c
@@ -615,8 +615,8 @@ cstcall(expp, call)
                if (tp->tp_fund == T_INTEGER) {
                        expr->nd_INT = max_int[(int)(tp->tp_size)];
                }
-               else if (tp == card_type) {
-                       expr->nd_INT = full_mask[(int)(int_size)];
+               else if (tp->tp_fund == T_CARDINAL) {
+                       expr->nd_INT = full_mask[(int)(tp->tp_size)];
                }
                else if (tp->tp_fund == T_SUBRANGE) {
                        expr->nd_INT = tp->sub_ub;

diff --git a/lang/m2/comp/em_m2.6 b/lang/m2/comp/em_m2.6
index 29e2eeb..a122a4a 100644 (file)
--- a/lang/m2/comp/em_m2.6
+++ b/lang/m2/comp/em_m2.6
@@ -65,8 +65,8 @@ make all procedure names global, so that \fIadb\fR(1) understands them.
 .IP \fB\-g\fR
 produce a DBX-style symbol table.
 .IP \fB\-l\fR
-enable local extensions. Currently, the only local extension consists of
-procedure constants.
+enable local extensions. Currently, there are two local extensions:
+procedure constants, and the type LONGCARD.
 .IP \fB\-s\fR
 make INTEGER ranges symmetric, t.i., MIN(INTEGER) = - MAX(INTEGER).
 This is useful for interpreters that use the "real" MIN(INTEGER) to

diff --git a/lang/m2/comp/main.c b/lang/m2/comp/main.c
index 47aa535..4b181eb 100644 (file)
--- a/lang/m2/comp/main.c
+++ b/lang/m2/comp/main.c
@@ -221,6 +221,10 @@ AddStandards()
        EnterType("REAL", real_type);
        EnterType("LONGREAL", longreal_type);
        EnterType("CARDINAL", card_type);
+       if (options['l']) {
+               /* local extension: LONGCARD. */
+               EnterType("LONGCARD", longcard_type);
+       }
        EnterType("(void)", void_type);
        df = Enter("NIL", D_CONST, address_type, 0);
        df->con_const = nilconst;

diff --git a/lang/m2/comp/type.H b/lang/m2/comp/type.H
index c051374..b677fa5 100644 (file)
--- a/lang/m2/comp/type.H
+++ b/lang/m2/comp/type.H
@@ -136,6 +136,7 @@ extern t_type
        *byte_type,
        *address_type,
        *intorcard_type,
+       *longintorcard_type,
        *bitset_type,
        *void_type,
        *std_type,

diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c
index 38a7e90..fa0283d 100644 (file)
--- a/lang/m2/comp/type.c
+++ b/lang/m2/comp/type.c
@@ -70,6 +70,7 @@ t_type
        *byte_type,
        *address_type,
        *intorcard_type,
+       *longintorcard_type,
        *bitset_type,
        *void_type,
        *std_type,
@@ -187,6 +188,7 @@ InitTypes()
        longcard_type = standard_type(T_CARDINAL, long_align, long_size);
        card_type = standard_type(T_CARDINAL, int_align, int_size);
        intorcard_type = standard_type(T_INTORCARD, int_align, int_size);
+       longintorcard_type = standard_type(T_INTORCARD, long_align, long_size);
 
        /* floating types
        */
@@ -844,13 +846,13 @@ t_type *
 intorcard(left, right)
        register t_type *left, *right;
 {
-       if (left == intorcard_type) {
+       if (left->tp_fund == T_INTORCARD) {
                t_type *tmp = left;
                left = right;
                right = tmp;
        }
-       if (right == intorcard_type) {
-               if (left == int_type || left == card_type) {
+       if (right->tp_fund == T_INTORCARD) {
+               if (left->tp_fund == T_INTEGER || left->tp_fund == T_CARDINAL) {
                        return left;
                }
        }

diff --git a/lang/m2/comp/typequiv.c b/lang/m2/comp/typequiv.c
index 1cec5ee..2a3efbb 100644 (file)
--- a/lang/m2/comp/typequiv.c
+++ b/lang/m2/comp/typequiv.c
@@ -111,8 +111,8 @@ TstCompat(tp1, tp2)
 
        tp1 = BaseType(tp1);
        tp2 = BaseType(tp2);
-       if (tp2 != intorcard_type &&
-           (tp1 == intorcard_type || tp1 == address_type)) {
+       if (tp2->tp_fund != T_INTORCARD &&
+           (tp1->tp_fund == T_INTORCARD || tp1 == address_type)) {
                t_type *tmp = tp2;
                
                tp2 = tp1;
@@ -125,10 +125,15 @@ TstCompat(tp1, tp2)
                &&
                   (tp1 == int_type || tp1 == card_type || tp1 == address_type)
                )
+           ||
+               (  tp2 == longintorcard_type
+               &&
+                  (tp1 == longint_type || tp1 == longcard_type || tp1 == address_type)
+               )
            ||
                (  tp2 == address_type
                && 
-                 ( tp1 == card_type || tp1->tp_fund == T_POINTER)
+                 ( tp1->tp_fund == T_CARDINAL || tp1->tp_fund == T_POINTER)
                )
        ;
 }