too many changes: some cosmetic; some for 2/4; some for added options

diff --git a/lang/m2/comp/modula-2.1 b/lang/m2/comp/modula-2.1
index 8e093f1..d3fd840 100644 (file)
--- a/lang/m2/comp/modula-2.1
+++ b/lang/m2/comp/modula-2.1
@@ -84,9 +84,6 @@ make all procedure names global, so that \fIadb\fR(1) understands them.
 make INTEGER ranges symmetric, t.i., MIN(INTEGER) = - MAX(INTEGER).
 This is useful for interpreters that use the "real" MIN(INTEGER) to
 indicate "undefined".
-.IP \fB\-Xi\fR\fIn\fR
-set maximum number of bits in a set to \fIn\fP.
-When not used, a default value is retained.
 .LP
 .SH SEE ALSO
 \fIack\fR(1), \fIem_m2\fR(6)

diff --git a/lang/m2/comp/options.c b/lang/m2/comp/options.c
index 8290a18..685ce90 100644 (file)
--- a/lang/m2/comp/options.c
+++ b/lang/m2/comp/options.c
@@ -21,6 +21,8 @@
 #include       "warning.h"
 #include       "nostrict.h"
 #include       "nocross.h"
+#include       "class.h"
+#include       "squeeze.h"
 
 #define        MINIDFSIZE      14
 
@@ -42,8 +44,14 @@ DoOption(text)
                options[*text]++;       /* debug options etc.   */
                break;
 
+       case 'U':       /* allow underscores in identifiers */
+               inidf['_'] = 1;
+               break;
        case 'L':       /* no fil/lin */
        case 'R':       /* no range checks */
+       case 'A':       /* extra array bound checks, for machines that do not
+                          implement it in AAR/LAR/SAR
+                       */
        case 'n':       /* no register messages */
        case 'x':       /* every name global */
        case 's':       /* symmetric: MIN(INTEGER) = -MAX(INTEGER) */
@@ -98,6 +106,7 @@ DoOption(text)
                break;
 
        case 'M': {     /* maximum identifier length */
+#ifndef SQUEEZE
                char *t = text;         /* because &text is illegal */
 
                idfsize = txt2int(&t);
@@ -111,6 +120,7 @@ DoOption(text)
                        warning(W_ORDINARY, "minimum identifier length is %d", MINIDFSIZE);
                        idfsize = MINIDFSIZE;
                }
+#endif
                }
                break;
 
@@ -223,6 +233,7 @@ DoOption(text)
        }
 }
 
+#if (!SQUEEZE) | (!NOCROSS)
 int
 txt2int(tp)
        register char **tp;
@@ -239,3 +250,4 @@ txt2int(tp)
        }
        return val;
 }
+#endif

diff --git a/lang/m2/comp/type.H b/lang/m2/comp/type.H
index 9d04c77..fe9a04f 100644 (file)
--- a/lang/m2/comp/type.H
+++ b/lang/m2/comp/type.H
@@ -45,9 +45,13 @@ struct array {
        struct type *ar_elem;   /* type of elements */
        label ar_descr;         /* label of array descriptor */
        arith ar_elsize;        /* size of elements */
+       arith ar_low;           /* lower bound of index */
+       arith ar_high;          /* upper bound of index */
 #define arr_elem       tp_value.tp_arr->ar_elem
 #define arr_descr      tp_value.tp_arr->ar_descr
 #define arr_elsize     tp_value.tp_arr->ar_elsize
+#define arr_low                tp_value.tp_arr->ar_low
+#define arr_high       tp_value.tp_arr->ar_high
 };
 
 /* ALLOCDEF "array" 5 */
@@ -117,6 +121,7 @@ extern t_type
        *int_type,
        *card_type,
        *longint_type,
+       *longcard_type,
        *real_type,
        *longreal_type,
        *word_type,

diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c
index 4e01858..bbaca8f 100644 (file)
--- a/lang/m2/comp/type.c
+++ b/lang/m2/comp/type.c
@@ -58,6 +58,7 @@ t_type
        *int_type,
        *card_type,
        *longint_type,
+       *longcard_type,
        *real_type,
        *longreal_type,
        *word_type,
@@ -92,7 +93,7 @@ construct_type(fund, tp)
 
        case T_ARRAY:
                dtp->tp_value.tp_arr = new_array();
-               if (tp) dtp->tp_align = tp->tp_align;
+               dtp->tp_align = struct_align;
                break;
 
        case T_SUBRANGE:
@@ -151,13 +152,8 @@ InitTypes()
                fatal("integer size not equal to word size");
        }
 
-       if ((int) int_size != (int) pointer_size) {
-               fatal("cardinal size not equal to pointer size");
-       }
-
-       if ((int) long_size < (int) int_size ||
-           (int) long_size % (int) word_size != 0) {
-               fatal("illegal long integer size");
+       if ((int) long_size < (int) int_size) {
+               fatal("long integer size smaller than integer size");
        }
 
        if ((int) double_size < (int) float_size) {
@@ -179,6 +175,7 @@ InitTypes()
        */
        int_type = standard_type(T_INTEGER, int_align, int_size);
        longint_type = standard_type(T_INTEGER, long_align, long_size);
+       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);
 
@@ -402,6 +399,9 @@ proc_type(result_type, parameters, n_bytes_params)
        if (! fit(n_bytes_params, (int) word_size)) {
                error("maximum parameter byte count exceeded");
        }
+       if (result_type && ! fit(WA(result_type->tp_size), (int) word_size)) {
+               error("maximum return value size exceeded");
+       }
        return tp;
 }
 
@@ -496,7 +496,6 @@ set_type(tp)
        return tp;
 }
 
-arith
 ArrayElSize(tp)
        register t_type *tp;
 {
@@ -505,16 +504,23 @@ ArrayElSize(tp)
           or a multiple of it.
        */
        register arith algn;
+       register t_type *elem_type = tp->arr_elem;
 
-       if (tp->tp_fund == T_ARRAY) ArraySizes(tp);
-       algn = align(tp->tp_size, tp->tp_align);
+       if (elem_type->tp_fund == T_ARRAY) ArraySizes(elem_type);
+       algn = align(elem_type->tp_size, elem_type->tp_align);
        if (word_size % algn != 0) {
                /* algn is not a dividor of the word size, so make sure it
                   is a multiple
                */
-               return WA(algn);
+               algn = WA(algn);
+       }
+       if (! fit(algn, (int) word_size)) {
+               error("element size of array too large");
+       }
+       tp->arr_elsize = algn;
+       if (tp->tp_align < elem_type->tp_align) {
+               tp->tp_align = elem_type->tp_align;
        }
-       return algn;
 }
 
 ArraySizes(tp)
@@ -523,25 +529,29 @@ ArraySizes(tp)
        /*      Assign sizes to an array type, and check index type
        */
        register t_type *index_type = IndexType(tp);
-       register t_type *elem_type = tp->arr_elem;
        arith lo, hi, diff;
 
-       tp->arr_elsize = ArrayElSize(elem_type);
-       tp->tp_align = elem_type->tp_align;
+       ArrayElSize(tp);
 
        /* check index type
        */
-       if (! bounded(index_type)) {
+       if (index_type->tp_size > word_size || ! bounded(index_type)) {
                error("illegal index type");
                tp->tp_size = tp->arr_elsize;
                return;
        }
 
        getbounds(index_type, &lo, &hi);
+       tp->arr_low = lo;
+       tp->arr_high = hi;
        diff = hi - lo;
 
-       tp->tp_size = (diff + 1) * tp->arr_elsize;
-       if (! fit(tp->tp_size, (int) word_size)) {
+       if (! fit(diff, (int) int_size)) {
+               error("too many elements in array");
+       }
+
+       tp->tp_size = align((diff + 1) * tp->arr_elsize, tp->tp_align);
+       if (! ufit(tp->tp_size, (int) pointer_size)) {
                error("array too large");
        }
 
@@ -549,7 +559,7 @@ ArraySizes(tp)
        */
        tp->arr_descr = ++data_label;
        C_df_dlb(tp->arr_descr);
-       C_rom_cst(lo);
+       C_rom_cst((arith) 0);
        C_rom_cst(diff);
        C_rom_cst(tp->arr_elsize);
 }

diff --git a/lang/m2/comp/typequiv.c b/lang/m2/comp/typequiv.c
index f021eef..4aae86c 100644 (file)
--- a/lang/m2/comp/typequiv.c
+++ b/lang/m2/comp/typequiv.c
@@ -146,8 +146,8 @@ TstAssCompat(tp1, tp2)
        tp1 = BaseType(tp1);
        tp2 = BaseType(tp2);
 
-       if ((tp1->tp_fund & T_INTORCARD) &&
-           (tp2->tp_fund & T_INTORCARD)) return 1;
+       if (((tp1->tp_fund & T_INTORCARD) || tp1 == address_type) &&
+           ((tp2->tp_fund & T_INTORCARD) || tp2 == address_type)) return 1;
 
        if ((tp1->tp_fund == T_REAL) &&
            (tp2->tp_fund == T_REAL)) return 1;

diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c
index e9cec07..c3120ad 100644 (file)
--- a/lang/m2/comp/walk.c
+++ b/lang/m2/comp/walk.c
@@ -297,7 +297,8 @@ WalkProcedure(procedure)
                                        }
                                        StackAdjustment = NewPtr();
                                        C_lor((arith) 1);
-                                       C_stl(StackAdjustment);
+                                       C_lal(StackAdjustment);
+                                       C_sti(pointer_size);
                                }
                                /* First compute new stackpointer */
                                C_lal(param->par_def->var_off);
@@ -306,11 +307,12 @@ WalkProcedure(procedure)
                                C_lfr(pointer_size);
                                C_str((arith) 1);
                                                /* adjusted stack pointer */
-                               C_lol(param->par_def->var_off);
+                               C_lal(param->par_def->var_off);
+                               C_loi(pointer_size);
                                                /* push source address */
                                C_cal("_copy_array");
                                                /* copy */
-                               C_asp(word_size);
+                               C_asp(pointer_size);
                        }
                }
        }
@@ -334,7 +336,8 @@ WalkProcedure(procedure)
                if (StackAdjustment) {
                        /* Remove copies of conformant arrays
                        */
-                       C_lol(StackAdjustment);
+                       C_lal(StackAdjustment);
+                       C_loi(pointer_size);
                        C_str((arith) 1);
                }
                c_lae_dlb(func_res_label);
@@ -349,7 +352,8 @@ WalkProcedure(procedure)
                        C_lal(retsav);
                        C_sti(func_res_size);
                }
-               C_lol(StackAdjustment);
+               C_lal(StackAdjustment);
+               C_loi(pointer_size);
                C_str((arith) 1);
                if (func_type) {
                        C_lal(retsav);