removed the limitation on number of include directories,

some bug fixes,
sets now have a constant and a variable part

diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile
index 2e170d3..781fe62 100644 (file)
--- a/lang/m2/comp/Makefile
+++ b/lang/m2/comp/Makefile
@@ -41,7 +41,7 @@ GENCFILES=    tokenfile.c \
 GENGFILES=     tokenfile.g
 GENHFILES=     errout.h\
        idfsize.h numsize.h strsize.h target_sizes.h \
-       inputtype.h maxset.h ndir.h density.h\
+       inputtype.h maxset.h density.h\
        def.h debugcst.h type.h Lpars.h node.h
 HFILES=                LLlex.h\
        chk_expr.h class.h const.h debug.h desig.h f_info.h idf.h\
@@ -164,6 +164,7 @@ error.o: node.h
 error.o: warning.h
 main.o: LLlex.h
 main.o: Lpars.h
+main.o: SYSTEM.h
 main.o: debug.h
 main.o: debugcst.h
 main.o: def.h
@@ -171,7 +172,6 @@ main.o: f_info.h
 main.o: idf.h
 main.o: input.h
 main.o: inputtype.h
-main.o: ndir.h
 main.o: node.h
 main.o: scope.h
 main.o: standards.h
@@ -288,7 +288,6 @@ chk_expr.o: type.h
 chk_expr.o: warning.h
 options.o: idfsize.h
 options.o: main.h
-options.o: ndir.h
 options.o: type.h
 options.o: warning.h
 walk.o: LLlex.h

diff --git a/lang/m2/comp/Parameters b/lang/m2/comp/Parameters
index fecdc8a..1e16606 100644 (file)
--- a/lang/m2/comp/Parameters
+++ b/lang/m2/comp/Parameters
@@ -57,9 +57,5 @@
                                   but what is a reasonable choice ???
                                */
 
-!File: ndir.h
-#define NDIRS  16              /* maximum number of directories searched */
-
-
 !File: density.h
 #define DENSITY        3               /* see casestat.C for an explanation */

diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c
index 95392b7..9693d1e 100644 (file)
--- a/lang/m2/comp/chk_expr.c
+++ b/lang/m2/comp/chk_expr.c
@@ -63,6 +63,10 @@ ChkVariable(expp)
                Xerror(expp, "variable expected", expp->nd_def);
                return 0;
        }
+       if (expp->nd_class == Value) {
+               node_error(expp, "variable expected");
+               return 0;
+       }
 
        return 1;
 }
@@ -182,14 +186,18 @@ ChkLinkOrName(expp)
 
                if (! ChkDesignator(left)) return 0;
 
-               if (left->nd_type->tp_fund != T_RECORD ||
-                   (left->nd_class == Def &&
-                    !(left->nd_def->df_kind & (D_MODULE|D_VARIABLE|D_FIELD))
+               if (left->nd_class == Def &&
+                   (left->nd_type->tp_fund != T_RECORD ||
+                   !(left->nd_def->df_kind & (D_MODULE|D_VARIABLE|D_FIELD))
                    )
                   ) {
                        Xerror(left, "illegal selection", left->nd_def);
                        return 0;
                }
+               if (left->nd_type->tp_fund != T_RECORD) {
+                       node_error(left, "illegal selection");
+                       return 0;
+               }
 
                if (!(df = lookup(expp->nd_IDF, left->nd_type->rec_scope, 1))) {
                        id_not_declared(expp);
@@ -273,8 +281,8 @@ node_error(expp, "standard or local procedures may not be assigned");
 }
 
 STATIC int
-ChkElement(expp, tp, set)
-       register struct node *expp;
+ChkElement(expp, tp, set, level)
+       struct node **expp;
        register struct type *tp;
        arith **set;
 {
@@ -282,15 +290,17 @@ ChkElement(expp, tp, set)
                recursively.
                Also try to compute the set!
        */
-       register struct node *left = expp->nd_left;
-       register struct node *right = expp->nd_right;
+       register struct node *expr = *expp;
+       register struct node *left = expr->nd_left;
+       register struct node *right = expr->nd_right;
        register int i;
 
-       if (expp->nd_class == Link && expp->nd_symb == UPTO) {
+       if (expr->nd_class == Link && expr->nd_symb == UPTO) {
                /* { ... , expr1 .. expr2,  ... }
                   First check expr1 and expr2, and try to compute them.
                */
-               if (!ChkElement(left, tp, set) || !ChkElement(right, tp, set)) {
+               if (!ChkElement(&(expr->nd_left), tp, set, 1) ||
+                   !ChkElement(&(expr->nd_right), tp, set, 1)) {
                        return 0;
                }
 
@@ -304,15 +314,11 @@ node_error(expp, "lower bound exceeds upper bound in range");
                                return 0;
                        }
 
-                       if (*set) {
-                               for (i=left->nd_INT+1; i<right->nd_INT; i++) {
-                                       (*set)[i/wrd_bits] |= (1<<(i%wrd_bits));
-                               }
+                       for (i=left->nd_INT; i<=right->nd_INT; i++) {
+                               (*set)[i/wrd_bits] |= (1<<(i%wrd_bits));
                        }
-               }
-               else if (*set) {
-                       free((char *) *set);
-                       *set = 0;
+                       FreeNode(expr);
+                       *expp = 0;
                }
 
                return 1;
@@ -320,27 +326,31 @@ node_error(expp, "lower bound exceeds upper bound in range");
 
        /* Here, a single element is checked
        */
-       if (!ChkExpression(expp)) return 0;
+       if (!ChkExpression(expr)) return 0;
 
-       if (!TstCompat(tp, expp->nd_type)) {
-               node_error(expp, "set element has incompatible type");
+       if (!TstCompat(tp, expr->nd_type)) {
+               node_error(expr, "set element has incompatible type");
                return 0;
        }
 
-       if (expp->nd_class == Value) {
+       if (expr->nd_class == Value) {
                /* a constant element
                */
                arith low, high;
 
-               i = expp->nd_INT;
+               i = expr->nd_INT;
                getbounds(tp, &low, &high);
 
                if (i < low || i > high) {
-                       node_error(expp, "set element out of range");
+                       node_error(expr, "set element out of range");
                        return 0;
                }
 
-               if (*set) (*set)[i/wrd_bits] |= (1 << (i%wrd_bits));
+               if (! level) {
+                       (*set)[i/wrd_bits] |= (1 << (i%wrd_bits));
+                       FreeNode(expr);
+                       *expp = 0;
+               }
        }
 
        return 1;
@@ -356,11 +366,13 @@ ChkSet(expp)
        register struct type *tp;
        register struct node *nd;
        register struct def *df;
-       arith *set;
        unsigned size;
+       int retval = 1;
 
        assert(expp->nd_symb == SET);
 
+       expp->nd_class = Set;
+
        /* First determine the type of the set
        */
        if (nd = expp->nd_left) {
@@ -392,37 +404,31 @@ ChkSet(expp)
        if (! nd) {
                /* The resulting set IS empty, so we just return
                */
-               expp->nd_class = Set;
                expp->nd_set = 0;
                return 1;
        }
        size = tp->tp_size * (sizeof(arith) / word_size);
-       set = (arith *) Malloc(size);
-       clear((char *) set, size);
+       expp->nd_set = (arith *) Malloc(size);
+       clear((char *) (expp->nd_set) , size);
 
        /* Now check the elements, one by one
        */
        while (nd) {
                assert(nd->nd_class == Link && nd->nd_symb == ',');
 
-               if (!ChkElement(nd->nd_left, ElementType(tp), &set)) return 0;
+               if (!ChkElement(&(nd->nd_left), ElementType(tp),
+                                               &(expp->nd_set), 0)) {
+                       retval = 0;
+               }
+               if (nd->nd_left) expp->nd_class = Xset;
                nd = nd->nd_right;
        }
 
-       if (set) {
-               /* Yes, it was a constant set, and we managed to compute it!
-                  Notice that at the moment there is no such thing as
-                  partial evaluation. Either we evaluate the set, or we
-                  don't (at all). Improvement not neccesary (???)
-                  ??? sets have a contant part and a variable part ???
-               */
-               expp->nd_class = Set;
-               expp->nd_set = set;
+       if (expp->nd_class == Set) {
                FreeNode(expp->nd_right);
                expp->nd_right = 0;
        }
-
-       return 1;
+       return retval;
 }
 
 STATIC struct node *
@@ -814,10 +820,8 @@ ChkUnOper(expp)
        switch(expp->nd_symb) {
        case '+':
                if (tpr->tp_fund & T_NUMERIC) {
-                       expp->nd_token = right->nd_token;
-                       expp->nd_class = right->nd_class;
-                       FreeNode(right);
-                       expp->nd_right = 0;
+                       *expp = *right;
+                       free_node(right);
                        return 1;
                }
                break;

diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c
index 46dc12b..f7afbae 100644 (file)
--- a/lang/m2/comp/code.c
+++ b/lang/m2/comp/code.c
@@ -140,6 +140,7 @@ CodeExpr(nd, ds, true_label, false_label)
                ds->dsg_kind = DSG_LOADED;
                break;
 
+       case Xset:
        case Set: {
                register arith *st = nd->nd_set;
                register int i;
@@ -153,14 +154,10 @@ CodeExpr(nd, ds, true_label, false_label)
                for (i = tp->tp_size / word_size, st += i; i > 0; i--) { 
                        C_loc(*--st);
                }
+               CodeSet(nd);
                }
                break;
 
-       case Xset:
-               CodeSet(nd);
-               ds->dsg_kind = DSG_LOADED;
-               break;
-               
        default:
                crash("(CodeExpr) bad node type");
        }
@@ -930,12 +927,11 @@ CodeSet(nd)
 {
        register struct type *tp = nd->nd_type;
 
-       C_zer(tp->tp_size);     /* empty set */
        nd = nd->nd_right;
        while (nd) {
                assert(nd->nd_class == Link && nd->nd_symb == ',');
 
-               CodeEl(nd->nd_left, tp);
+               if (nd->nd_left) CodeEl(nd->nd_left, tp);
                nd = nd->nd_right;
        }
 }

diff --git a/lang/m2/comp/em_m2.6 b/lang/m2/comp/em_m2.6
index e1f704f..6851f77 100644 (file)
--- a/lang/m2/comp/em_m2.6
+++ b/lang/m2/comp/em_m2.6
@@ -62,6 +62,9 @@ By default, warnings in class \fBO\fR and \fBW\fR are given.
 allow for warning messages whose class is a member of \fIclasses\fR.
 .IP \fB\-x\fR
 make all procedure names global, so that \fIadb\fR(1) understands them.
+.IP \fB\-i\fR\fInum\fR
+maximum number of bits in a set. When not used, a default value is
+retained.
 .LP
 .SH FILES
 .IR ~em/lib/em_m2 :

diff --git a/lang/m2/comp/main.c b/lang/m2/comp/main.c
index 7e398ba..427fb24 100644 (file)
--- a/lang/m2/comp/main.c
+++ b/lang/m2/comp/main.c
@@ -10,7 +10,6 @@
 /* $Header$ */
 
 #include       "debug.h"
-#include       "ndir.h"
 
 #include       <system.h>
 #include       <em_arith.h>
@@ -34,7 +33,8 @@ int           state;                  /* either IMPLEMENTATION or PROGRAM */
 char           options[128];
 int            DefinitionModule; 
 char           *ProgName;
-char           *DEFPATH[NDIRS+1];
+char           **DEFPATH;
+int            nDEF, mDEF;
 struct def     *Defined;
 extern int     err_occurred;
 extern int     fp_used;                /* set if floating point used */
@@ -50,6 +50,9 @@ main(argc, argv)
 
        ProgName = *argv++;
        warning_classes = W_INITIAL;
+       DEFPATH = (char **) Malloc(10 * sizeof(char *));
+       mDEF = 10;
+       nDEF = 1;
 
        while (--argc > 0) {
                if (**argv == '-')
@@ -60,10 +63,10 @@ main(argc, argv)
        Nargv[Nargc] = 0;       /* terminate the arg vector     */
        if (Nargc < 2) {
                fprint(STDERR, "%s: Use a file argument\n", ProgName);
-               return 1;
+               exit(1);
        }
        if (options['x']) c_inp = C_exp;
-       return !Compile(Nargv[1], Nargv[2]);
+       exit(!Compile(Nargv[1], Nargv[2]));
 }
 
 Compile(src, dst)

diff --git a/lang/m2/comp/main.h b/lang/m2/comp/main.h
index d79a912..a98b867 100644 (file)
--- a/lang/m2/comp/main.h
+++ b/lang/m2/comp/main.h
@@ -20,5 +20,6 @@ extern struct def *Defined;
                        /* definition structure of module defined in this
                           compilation
                        */
-extern char *DEFPATH[];        /* search path for DEFINITION MODULE's */
+extern char **DEFPATH; /* search path for DEFINITION MODULE's */
+extern int mDEF, nDEF;
 extern int state;      /* either IMPLEMENTATION or PROGRAM */

diff --git a/lang/m2/comp/options.c b/lang/m2/comp/options.c
index da084b7..6bcf3d1 100644 (file)
--- a/lang/m2/comp/options.c
+++ b/lang/m2/comp/options.c
@@ -10,7 +10,6 @@
 /* $Header$ */
 
 #include       "idfsize.h"
-#include       "ndir.h"
 
 #include       <em_arith.h>
 #include       <em_label.h>
@@ -46,6 +45,19 @@ DoOption(text)
                options[text[-1]]++;
                break;
 
+       case 'i':       /* # of bits in set */
+       {
+               char *t = text;
+               int val;
+               extern int maxset;
+
+               val = txt2int(&t);
+               if (val <= 0 || *t) {
+                       error("bad -i flag; use -i<num>");
+               }
+               else    maxset = val;
+               break;
+       }
        case 'w':
                if (*text) {
                        while (*text) {
@@ -100,13 +112,25 @@ DoOption(text)
 
        case 'I' :
                if (*text) {
-                       register int i = ndirs++;
+                       register int i;
                        register char *new = text;
+
+                       if (++nDEF > mDEF) {
+                               char **n = (char **)
+                                       Malloc((10+mDEF)*sizeof(char *));
+
+                               for (i = 0; i < mDEF; i++) {
+                                       n[i] = DEFPATH[i];
+                               }
+                               free((char *) DEFPATH);
+                               DEFPATH = n;
+                               mDEF += 10;
+                       }
+
+                       i = ndirs++;
                        while (new) {
                                register char *tmp = DEFPATH[i];
        
-                               if (i >= NDIRS)
-                                       fatal("too many -I options");
                                DEFPATH[i++] = new;
                                new = tmp;
                        }

diff --git a/lang/m2/comp/scope.C b/lang/m2/comp/scope.C
index 6fbde4a..337feef 100644 (file)
--- a/lang/m2/comp/scope.C
+++ b/lang/m2/comp/scope.C
@@ -207,7 +207,7 @@ close_scope(flag)
        assert(sc != 0);
 
        if (flag) {
-               DO_DEBUG(options['S'], PrScopeDef(sc->sc_def));
+               DO_DEBUG(options['S'],(print("List of definitions in currently ended scope:\n"), DumpScope(sc->sc_def)));
                if (flag & SC_CHKPROC) chk_proc(sc->sc_def);
                if (flag & SC_CHKFORW) chk_forw(&(sc->sc_def));
                if (flag & SC_REVERSE) Reverse(&(sc->sc_def));
@@ -216,10 +216,9 @@ close_scope(flag)
 }
 
 #ifdef DEBUG
-PrScopeDef(df)
+DumpScope(df)
        register struct def *df;
 {
-       print("List of definitions in currently ended scope:\n");
        while (df) {
                PrDef(df);
                df = df->df_nextinscope;

diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c
index 784e921..b9eb03c 100644 (file)
--- a/lang/m2/comp/type.c
+++ b/lang/m2/comp/type.c
@@ -39,6 +39,9 @@ int
        pointer_align = AL_POINTER,
        struct_align = AL_STRUCT;
 
+int
+       maxset = MAXSET;
+
 arith
        word_size = SZ_WORD,
        dword_size = 2 * SZ_WORD,
@@ -436,7 +439,7 @@ set_type(tp)
 
        getbounds(tp, &lb, &ub);
 
-       if (lb < 0 || ub > MAXSET-1) {
+       if (lb < 0 || ub > maxset-1) {
                error("set type limits exceeded");
                return error_type;
        }
@@ -648,7 +651,9 @@ DumpType(tp)
        print(" fund:");
        switch(tp->tp_fund) {
        case T_RECORD:
-               print("RECORD"); break;
+               print("RECORD\n");
+               DumpScope(tp->rec_scope);
+               break;
        case T_ENUMERATION:
                print("ENUMERATION; ncst:%d", tp->enm_ncst); break;
        case T_INTEGER: