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

diff --git a/lang/m2/comp/LLlex.c b/lang/m2/comp/LLlex.c
index 4ba4659..5309114 100644 (file)
--- a/lang/m2/comp/LLlex.c
+++ b/lang/m2/comp/LLlex.c
@@ -50,7 +50,7 @@ SkipComment()
        /*      Skip Modula-2 comments (* ... *).
                Note that comments may be nested (par. 3.5).
        */
-       register int ch;
+       register int ch, c;
        register int CommentLevel = 0;
 
        LoadChar(ch);
@@ -66,17 +66,23 @@ SkipComment()
                        */
                        ForeignFlag = D_FOREIGN;
                        break;
-               case 'R':
-                       /* Range checks, on or off */
-                       LoadChar(ch);
-                       if (ch == '-') {
-                               options['R'] = 1;
+               case 'U':
+                       inidf['_'] = 1;
+                       break;
+               case 'A': /* Extra array bound checks, on or off */
+               case 'R': /* Range checks, on or off */
+               {
+                       int on_on_minus = ch == 'R';
+                       LoadChar(c);
+                       if (c == '-') {
+                               options[ch] = on_on_minus;
                                break;
                        }
-                       if (ch == '+') {
-                               options['R'] = 0;
+                       if (c == '+') {
+                               options[ch] = !on_on_minus;
                                break;
                        }
+               }
                        /* fall through */
                default:
                        PushBack();
@@ -365,6 +371,9 @@ again:
                }
                else {
                        tk->tk_data.tk_str = str;
+                       if (! fit(str->s_length, (int) word_size)) {
+                               lexerror("string too long");
+                       }
                        toktype = standard_type(T_STRING, 1, str->s_length);
                }
                return tk->tk_symb = STRING;
@@ -504,11 +513,11 @@ lexwarning(W_ORDINARY, "overflow in constant");
                                        toktype = longint_type;
                                }
                                else if (sgnswtch == 0 &&
-                                        tk->TOK_INT<=max_int[(int)word_size]) {
+                                        tk->TOK_INT<=max_int[(int)int_size]) {
                                        toktype = intorcard_type;
                                }
                                else if (! chk_bounds(tk->TOK_INT,
-                                                     full_mask[(int)word_size],
+                                                     full_mask[(int)int_size],
                                                      T_CARDINAL)) {
 lexwarning(W_ORDINARY, "overflow in constant");
                                }

diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile
index b5a8ecf..938708c 100644 (file)
--- a/lang/m2/comp/Makefile
+++ b/lang/m2/comp/Makefile
@@ -1,8 +1,9 @@
 # make modula-2 "compiler"
-EMHOME =               ../../..
-MHDIR =                $(EMHOME)/modules/h
-PKGDIR =       $(EMHOME)/modules/pkg
-LIBDIR =       $(EMHOME)/modules/lib
+EMHOME =       ../../..
+MDIR =         $(EMHOME)/modules
+MHDIR =                $(MDIR)/h
+PKGDIR =       $(MDIR)/pkg
+LIBDIR =       $(MDIR)/lib
 OBJECTCODE =   $(LIBDIR)/libemk.a
 LLGEN =                $(EMHOME)/bin/LLgen
 MKDEP =                $(EMHOME)/bin/mkdep
@@ -325,10 +326,12 @@ chk_expr.o: strict3rd.h
 chk_expr.o: target_sizes.h
 chk_expr.o: type.h
 chk_expr.o: warning.h
+options.o: class.h
 options.o: idfsize.h
 options.o: main.h
 options.o: nocross.h
 options.o: nostrict.h
+options.o: squeeze.h
 options.o: strict3rd.h
 options.o: target_sizes.h
 options.o: type.h

diff --git a/lang/m2/comp/Parameters b/lang/m2/comp/Parameters
index 127248d..a05f79a 100644 (file)
--- a/lang/m2/comp/Parameters
+++ b/lang/m2/comp/Parameters
@@ -23,26 +23,25 @@
 #define MAXSIZE                8       /* the maximum of the SZ_* constants    */
 
 /* target machine sizes        */
-#define        SZ_CHAR         (arith)1
-#define        SZ_SHORT        (arith)2
-#define SZ_WORD                (arith)4
-#define        SZ_INT          (arith)4
-#define        SZ_LONG         (arith)4
-#define        SZ_FLOAT        (arith)4
-#define        SZ_DOUBLE       (arith)8
-#define        SZ_POINTER      (arith)4
+#define        SZ_CHAR         ((arith)1)
+#define        SZ_SHORT        ((arith)2)
+#define SZ_WORD                ((arith)4)
+#define        SZ_INT          ((arith)4)
+#define        SZ_LONG         ((arith)4)
+#define        SZ_FLOAT        ((arith)4)
+#define        SZ_DOUBLE       ((arith)8)
+#define        SZ_POINTER      ((arith)4)
 
 /* target machine alignment requirements       */
 #define        AL_CHAR         1
-#define        AL_SHORT        (int)SZ_SHORT
-#define AL_WORD                (int)SZ_WORD
-#define        AL_INT          (int)SZ_WORD
-#define        AL_LONG         (int)SZ_WORD
-#define        AL_FLOAT        (int)SZ_WORD
-#define        AL_DOUBLE       (int)SZ_WORD
-#define        AL_POINTER      (int)SZ_WORD
-#define AL_STRUCT      1
-#define AL_UNION       1
+#define        AL_SHORT        ((int)SZ_SHORT)
+#define AL_WORD                ((int)SZ_WORD)
+#define        AL_INT          ((int)SZ_WORD)
+#define        AL_LONG         ((int)SZ_WORD)
+#define        AL_FLOAT        ((int)SZ_WORD)
+#define        AL_DOUBLE       ((int)SZ_WORD)
+#define        AL_POINTER      ((int)SZ_WORD)
+#define AL_STRUCT      ((int)SZ_WORD)
 
 
 !File: debugcst.h

diff --git a/lang/m2/comp/casestat.C b/lang/m2/comp/casestat.C
index 3e93b6f..e21c542 100644 (file)
--- a/lang/m2/comp/casestat.C
+++ b/lang/m2/comp/casestat.C
@@ -73,7 +73,8 @@ compact(nr, low, up)
        */
        arith diff = up - low;
 
-       return (nr == 0 || (diff >= 0 && diff / nr <= (DENSITY - 1)));
+       return (nr != 0 && diff >= 0 && fit(diff, (int) word_size) &&
+               diff / nr <= (DENSITY - 1));
 }
 
 CaseCode(nd, exitlabel)
@@ -149,11 +150,10 @@ CaseCode(nd, exitlabel)
        if (compact(sh->sh_nrofentries, sh->sh_lowerbd, sh->sh_upperbd)) {
                /* CSA
                */
-               C_rom_cst(sh->sh_lowerbd);
-               C_rom_cst(sh->sh_upperbd - sh->sh_lowerbd);
                ce = sh->sh_entries;
-               if (sh->sh_nrofentries)
-                   for (val = sh->sh_lowerbd; val <= sh->sh_upperbd; val++) {
+               C_rom_cst((arith) 0);
+               C_rom_cst(sh->sh_upperbd - sh->sh_lowerbd);
+               for (val = sh->sh_lowerbd; val <= sh->sh_upperbd; val++) {
                        assert(ce);
                        if (val == ce->ce_value)        {
                                C_rom_ilb(ce->ce_label);
@@ -162,6 +162,8 @@ CaseCode(nd, exitlabel)
                        else if (sh->sh_default) C_rom_ilb(sh->sh_default);
                        else C_rom_ucon("0", pointer_size);
                }
+               C_loc(sh->sh_lowerbd);
+               C_sbu(word_size);
                c_lae_dlb(CaseDescrLab);        /* perform the switch */
                C_csa(word_size);
        }

diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c
index 4bf812a..58de781 100644 (file)
--- a/lang/m2/comp/chk_expr.c
+++ b/lang/m2/comp/chk_expr.c
@@ -282,9 +282,9 @@ ChkLinkOrName(expp, flags)
                        /* Fields of a record are always D_QEXPORTED,
                           so ...
                        */
-                       df_error(expp,
+                       if (df_error(expp,
                               "not exported from qualifying module",
-                              df);
+                              df)) assert(0);
                }
 
                if (!(left->nd_class == Def &&
@@ -617,7 +617,7 @@ ChkProcCall(expp)
                /* Just check parameters as if they were value parameters
                */
                while (expp->nd_right) {
-                       getarg(&expp, 0, 0, edf);
+                       if (getarg(&expp, 0, 0, edf)) { }
                }
                return 0;
        }
@@ -646,9 +646,11 @@ ChkProcCall(expp)
        }
 
        if (expp->nd_right) {
-               df_error(expp->nd_right, "too many parameters supplied", edf);
+               if (df_error(expp->nd_right,"too many parameters supplied",edf)){
+                       assert(0);
+               }
                while (expp->nd_right) {
-                       getarg(&expp, 0, 0, edf);
+                       if (getarg(&expp, 0, 0, edf)) { }
                }
                return 0;
        }
@@ -779,20 +781,47 @@ AllowedTypes(operator)
 }
 
 STATIC int
-ChkAddress(tpl, tpr)
+ChkAddressOper(tpl, tpr, expp)
        register t_type *tpl, *tpr;
+       register t_node *expp;
 {
        /*      Check that either "tpl" or "tpr" are both of type
                address_type, or that one of them is, but the other is
-               of type cardinal.
+               of a cardinal type.
+               Also insert proper coercions, making sure that the EM pointer
+               arithmetic instructions can be generated whenever possible
        */
+
+       if (tpr == address_type && expp->nd_symb == '+') {
+               /* use the fact that '+' is a commutative operator */
+               t_type *tmptype = tpr;
+               t_node *tmpnode = expp->nd_right;
+
+               tpr = tpl;
+               expp->nd_right = expp->nd_left;
+               tpl = tmptype;
+               expp->nd_left = tmpnode;
+       }
        
        if (tpl == address_type) {
-               return tpr == address_type || (tpr->tp_fund & T_CARDINAL);
+               expp->nd_type = address_type;
+               if (tpr == address_type) {
+                       return 1;
+               }
+               if (tpr->tp_fund & T_CARDINAL) {
+                       MkCoercion(&(expp->nd_right),
+                                  expp->nd_symb=='+' || expp->nd_symb=='-' ?
+                                       tpr :
+                                       address_type);
+                       return 1;
+               }
+               return 0;
        }
 
-       if (tpr == address_type) {
-               return (tpl->tp_fund & T_CARDINAL);
+       if (tpr == address_type && tpl->tp_fund & T_CARDINAL) {
+               expp->nd_type = address_type;
+               MkCoercion(&(expp->nd_left), address_type);
+               return 1;
        }
 
        return 0;
@@ -804,13 +833,13 @@ ChkBinOper(expp)
 {
        /*      Check a binary operation.
        */
-       register t_node *left, *right;
+       register t_node *left = expp->nd_left, *right = expp->nd_right;
        register t_type *tpl, *tpr;
+       t_type *result_type;
        int allowed;
        int retval;
 
-       left = expp->nd_left;
-       right = expp->nd_right;
+       /* First, check BOTH operands */
 
        retval = ChkExpression(left) & ChkExpression(right);
 
@@ -828,7 +857,7 @@ ChkBinOper(expp)
                }
        }
 
-       expp->nd_type = ResultOfOperation(expp->nd_symb, tpr);
+       expp->nd_type = result_type = ResultOfOperation(expp->nd_symb, tpr);
 
        /* Check that the application of the operator is allowed on the type
           of the operands.
@@ -866,27 +895,26 @@ ChkBinOper(expp)
 
        if (!(tpr->tp_fund & allowed) || !(tpl->tp_fund & allowed)) {
                if (!((T_CARDINAL & allowed) &&
-                    ChkAddress(tpl, tpr))) {
+                    ChkAddressOper(tpl, tpr, expp))) {
                        return ex_error(expp, "illegal operand type(s)");
                }
-               if (expp->nd_type->tp_fund & T_CARDINAL) {
-                       expp->nd_type = address_type;
-               }
+               if (result_type == bool_type) expp->nd_type = bool_type;
        }
+       else {
+               if (Boolean(expp->nd_symb) && tpl != bool_type) {
+                       return ex_error(expp, "illegal operand type(s)");
+               }
 
-       if (Boolean(expp->nd_symb) && tpl != bool_type) {
-               return ex_error(expp, "illegal operand type(s)");
-       }
+               /* Operands must be compatible (distilled from Def 8.2)
+               */
+               if (!TstCompat(tpr, tpl)) {
+                       return ex_error(expp, "incompatible operand types");
+               }
 
-       /* Operands must be compatible (distilled from Def 8.2)
-       */
-       if (!TstCompat(tpr, tpl)) {
-               return ex_error(expp, "incompatible operand types");
+               MkCoercion(&(expp->nd_left), tpl);
+               MkCoercion(&(expp->nd_right), tpr);
        }
 
-       MkCoercion(&(expp->nd_left), tpl);
-       MkCoercion(&(expp->nd_right), tpr);
-
        if (tpl->tp_fund == T_SET) {
                if (left->nd_class == Set && right->nd_class == Set) {
                        cstset(expp);
@@ -1071,7 +1099,9 @@ ChkStandard(expp)
                        MkCoercion(&(arg->nd_left), d2);
                }
                else {
-                       df_error(left, "unexpected parameter type", edf);
+                       if (df_error(left, "unexpected parameter type", edf)) {
+                               assert(0);
+                       }
                        break;
                }
                free_it = 1;