newer version

diff --git a/lang/m2/comp/LLlex.c b/lang/m2/comp/LLlex.c
index 9edc42d..c7738c6 100644 (file)
--- a/lang/m2/comp/LLlex.c
+++ b/lang/m2/comp/LLlex.c
@@ -121,7 +121,6 @@ LLlex()
                return tk->tk_symb;
        }
        tk->tk_lineno = LineNumber;
-       tk->tk_filename = FileName;
 
 again:
        LoadChar(ch);

diff --git a/lang/m2/comp/LLlex.h b/lang/m2/comp/LLlex.h
index bf207ad..dae0151 100644 (file)
--- a/lang/m2/comp/LLlex.h
+++ b/lang/m2/comp/LLlex.h
@@ -8,9 +8,8 @@ struct string {
 };
 
 struct token   {
-       int tk_symb;            /* token itself */
-       char *tk_filename;      /* filename in which it occurred */
-       int tk_lineno;          /* linenumber on which it occurred */
+       short tk_symb;          /* token itself */
+       unsigned short tk_lineno;       /* linenumber on which it occurred */
        union {
                struct idf *tk_idf;     /* IDENT        */
                struct string *tk_str;  /* STRING       */

diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c
index 31e505d..daf2bef 100644 (file)
--- a/lang/m2/comp/chk_expr.c
+++ b/lang/m2/comp/chk_expr.c
@@ -503,15 +503,12 @@ df->df_idf->id_text);
                                expp->nd_symb = INTEGER;
                        }
                        else  {
-                               char *fn;
-                               int ln;
+                               unsigned int ln;
 
                                assert(df->df_kind == D_CONST);
                                ln = expp->nd_lineno;
-                               fn = expp->nd_filename;
                                *expp = *(df->con_const);
                                expp->nd_lineno = ln;
-                               expp->nd_filename = fn;
                        }
                }
 

diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c
index 668d527..cd2101f 100644 (file)
--- a/lang/m2/comp/code.c
+++ b/lang/m2/comp/code.c
@@ -51,7 +51,6 @@ CodeConst(cst, size)
 CodeString(nd)
        struct node *nd;
 {
-       
        label lab;
        
        if (nd->nd_type == charc_type) {
@@ -75,8 +74,8 @@ CodeReal(nd)
 }
 
 CodeExpr(nd, ds, true_label, false_label)
-       struct node *nd;
-       struct desig *ds;
+       register struct node *nd;
+       register struct desig *ds;
        label true_label, false_label;
 {
 
@@ -135,9 +134,22 @@ CodeExpr(nd, ds, true_label, false_label)
                ds->dsg_kind = DSG_LOADED;
                break;
 
+       case Set: {
+               arith *st;
+               int i;
+
+               st = nd->nd_set;
+               for (i = nd->nd_type->tp_size / word_size, st = nd->nd_set + i;
+                    i > 0;
+                    i--) { 
+                       C_loc(*--st);
+               }
+               ds->dsg_kind = DSG_LOADED;
+               }
+               break;
+
        case Xset:
-       case Set:
-               /* ??? */
+               CodeSet(nd);
                ds->dsg_kind = DSG_LOADED;
                break;
                
@@ -160,7 +172,7 @@ CodeCoercion(t1, t2)
 }
 
 CodeCall(nd)
-       struct node *nd;
+       register struct node *nd;
 {
        /*      Generate code for a procedure call. Checking of parameters
                and result is already done.
@@ -250,7 +262,7 @@ CodeAssign(nd, dst, dss)
 }
 
 Operands(leftop, rightop)
-       struct node *leftop, *rightop;
+       register struct node *leftop, *rightop;
 {
        struct desig Des;
 
@@ -514,7 +526,7 @@ CodeOper(expr, true_label, false_label)
 /*     compare() serves as an auxiliary function of CodeOper   */
 compare(relop, lbl)
        int relop;
-       label lbl;
+       register label lbl;
 {
        switch (relop)  {
        case '<':
@@ -596,3 +608,42 @@ CodeUoper(nd)
                crash("Bad unary operator");
        }
 }
+
+CodeSet(nd)
+       register struct node *nd;
+{
+       struct type *tp = nd->nd_type;
+
+       nd = nd->nd_right;
+       while (nd) {
+               assert(nd->nd_class == Link && nd->nd_symb == ',');
+
+               CodeEl(nd->nd_left, tp);
+               nd = nd->nd_right;
+               if (nd) {
+                       C_ior(tp->tp_size);
+               }
+       }
+}
+
+CodeEl(nd, tp)
+       register struct node *nd;
+       struct type *tp;
+{
+
+       if (nd->nd_class == Link && nd->nd_symb == UPTO) {
+               C_zer(tp->tp_size);     /* empty set */
+               C_lor((arith) 1);       /* SP: address of set */
+               Operands(nd->nd_left, nd->nd_right);
+               C_cal("_LtoUset");      /* library routine to fill set */
+               C_asp(2 * word_size + pointer_size);
+       }
+       else {
+               struct desig Des;
+
+               Des = InitDesig;
+               CodeExpr(nd, &Des, NO_LABEL, NO_LABEL);
+               CodeValue(nd, word_size);
+               C_set(tp->tp_size);
+       }
+}

diff --git a/lang/m2/comp/def.H b/lang/m2/comp/def.H
index 95037b6..176452c 100644 (file)
--- a/lang/m2/comp/def.H
+++ b/lang/m2/comp/def.H
@@ -61,7 +61,6 @@ struct dforward {
        char *fo_name;
 #define for_node       df_value.df_forward.fo_node
 #define for_vis                df_value.df_forward.fo_vis
-#define for_scopes     df_value.df_forward.fo_scopes
 #define for_name       df_value.df_forward.fo_name
 };
 

diff --git a/lang/m2/comp/desig.c b/lang/m2/comp/desig.c
index 79d0f60..fd7949b 100644 (file)
--- a/lang/m2/comp/desig.c
+++ b/lang/m2/comp/desig.c
@@ -329,6 +329,7 @@ CodeDesig(nd, ds)
 
        case Oper:
                assert(nd->nd_symb == '[');
+
                CodeDesig(nd->nd_left, ds);
                CodeAddress(ds);
                *ds = InitDesig;
@@ -348,6 +349,7 @@ CodeDesig(nd, ds)
 
        case Uoper:
                assert(nd->nd_symb == '^');
+
                CodeDesig(nd->nd_right, ds);
                switch(ds->dsg_kind) {
                case DSG_LOADED:

diff --git a/lang/m2/comp/error.c b/lang/m2/comp/error.c
index a430f70..3c612e1 100644 (file)
--- a/lang/m2/comp/error.c
+++ b/lang/m2/comp/error.c
@@ -137,9 +137,8 @@ _error(class, node, fmt, argv)
        static unsigned int last_ln = 0;
        unsigned int ln = 0;
        static char * last_fn = 0;
-       char *fn = 0;
        static int e_seen = 0;
-       char *remark = 0;
+       register char *remark = 0;
        
        /*      Since name and number are gathered from different places
                depending on the class, we first collect the relevant
@@ -185,7 +184,6 @@ _error(class, node, fmt, argv)
        switch (class)  {       
        case WARNING:
        case ERROR:
-               fn = node ? node->nd_filename : dot.tk_filename;
                ln = node ? node->nd_lineno : dot.tk_lineno;
                break;
        case LEXWARNING:
@@ -196,14 +194,13 @@ _error(class, node, fmt, argv)
        case VDEBUG:
 #endif DEBUG
                ln = LineNumber;
-               fn = FileName;
                break;
        }
        
 #ifdef DEBUG
        if (class != VDEBUG) {
 #endif
-       if (fn == last_fn && ln == last_ln)     {
+       if (FileName == last_fn && ln == last_ln)       {
                /* we've seen this place before */
                e_seen++;
                if (e_seen == MAXERR_LINE) fmt = "etc ...";
@@ -215,14 +212,14 @@ _error(class, node, fmt, argv)
        else    {
                /* brand new place */
                last_ln = ln;
-               last_fn = fn;
+               last_fn = FileName;
                e_seen = 0;
        }
 #ifdef DEBUG
        }
 #endif DEBUG
        
-       if (fn) fprint(ERROUT, "\"%s\", line %u: ", fn, ln);
+       if (FileName) fprint(ERROUT, "\"%s\", line %u: ", FileName, ln);
 
        if (remark) fprint(ERROUT, "%s ", remark);
 

diff --git a/lang/m2/comp/f_info.h b/lang/m2/comp/f_info.h
index 92b1710..edee620 100644 (file)
--- a/lang/m2/comp/f_info.h
+++ b/lang/m2/comp/f_info.h
@@ -3,7 +3,7 @@
 /* $Header$ */
 
 struct f_info {
-       unsigned int f_lineno;
+       unsigned short f_lineno;
        char *f_filename;
        char *f_workingdir;
 };

diff --git a/lang/m2/comp/main.c b/lang/m2/comp/main.c
index 62b780d..d4e112d 100644 (file)
--- a/lang/m2/comp/main.c
+++ b/lang/m2/comp/main.c
@@ -140,7 +140,7 @@ AddStandards()
 {
        register struct def *df;
        struct def *Enter();
-       static struct node nilnode = { 0, 0, Value, 0, { INTEGER, 0, 0}};
+       static struct node nilnode = { 0, 0, Value, 0, { INTEGER, 0}};
 
        (void) Enter("ABS", D_PROCEDURE, std_type, S_ABS);
        (void) Enter("CAP", D_PROCEDURE, std_type, S_CAP);

diff --git a/lang/m2/comp/node.H b/lang/m2/comp/node.H
index c8c2921..859e4bb 100644 (file)
--- a/lang/m2/comp/node.H
+++ b/lang/m2/comp/node.H
@@ -24,7 +24,6 @@ struct node {
 #define nd_lab         nd_token.tk_data.tk_lab
 #define nd_symb                nd_token.tk_symb
 #define nd_lineno      nd_token.tk_lineno
-#define nd_filename    nd_token.tk_filename
 #define nd_IDF         nd_token.TOK_IDF
 #define nd_STR         nd_token.TOK_STR
 #define nd_SLE         nd_token.TOK_SLE

diff --git a/lang/m2/comp/node.c b/lang/m2/comp/node.c
index d0c982c..352347c 100644 (file)
--- a/lang/m2/comp/node.c
+++ b/lang/m2/comp/node.c
@@ -43,8 +43,8 @@ FreeNode(nd)
                list
        */
        if (!nd) return;
-       if (nd->nd_left) FreeNode(nd->nd_left);
-       if (nd->nd_right) FreeNode(nd->nd_right);
+       FreeNode(nd->nd_left);
+       FreeNode(nd->nd_right);
        free_node(nd);
 }
 

diff --git a/lang/m2/comp/type.H b/lang/m2/comp/type.H
index b9c0eaf..b0cbd56 100644 (file)
--- a/lang/m2/comp/type.H
+++ b/lang/m2/comp/type.H
@@ -29,11 +29,8 @@ struct subrange {
 
 struct array {
        struct type *ar_elem;   /* Type of elements */
-       arith ar_lb, ar_ub;     /* Lower bound and upper bound */
        label ar_descr;         /* Label of array descriptor */
 #define arr_elem       tp_value.tp_arr.ar_elem
-#define arr_lb         tp_value.tp_arr.ar_lb
-#define arr_ub         tp_value.tp_arr.ar_ub
 #define arr_descr      tp_value.tp_arr.ar_descr
 };
 

diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c
index 5898569..cdea3b4 100644 (file)
--- a/lang/m2/comp/type.c
+++ b/lang/m2/comp/type.c
@@ -387,15 +387,11 @@ ArraySizes(tp)
        */
        switch(index_type->tp_fund) {
        case T_SUBRANGE:
-               tp->arr_lb = index_type->sub_lb;
-               tp->arr_ub = index_type->sub_ub;
                tp->tp_size = elem_size *
                        (index_type->sub_ub - index_type->sub_lb + 1);
                break;
        case T_CHAR:
        case T_ENUMERATION:
-               tp->arr_lb = 0;
-               tp->arr_ub = index_type->enm_ncst - 1;
                tp->tp_size = elem_size * index_type->enm_ncst;
                break;
        default:
@@ -453,6 +449,8 @@ lcm(m, n)
 DumpType(tp)
        register struct type *tp;
 {
+       if (!tp) return;
+
        print(" a:%d; s:%ld;", tp->tp_align, (long) tp->tp_size);
        if (tp->next && tp->tp_fund != T_POINTER) {
                /* Avoid printing recursive types!
@@ -501,9 +499,11 @@ DumpType(tp)
                break;
                }
        case T_ARRAY:
-               print("ARRAY %ld-%ld", (long) tp->arr_lb, (long) tp->arr_ub);
+               print("ARRAY");
                print("; el:");
                DumpType(tp->arr_elem);
+               print("; index:");
+               DumpType(tp->next);
                break;
        case T_STRING:
                print("STRING"); break;

diff --git a/lang/m2/comp/typequiv.c b/lang/m2/comp/typequiv.c
index 2ddd5cf..266a06a 100644 (file)
--- a/lang/m2/comp/typequiv.c
+++ b/lang/m2/comp/typequiv.c
@@ -128,11 +128,12 @@ TstCompat(tp1, tp2)
 
 int
 TstAssCompat(tp1, tp2)
-       struct type *tp1, *tp2;
+       register struct type *tp1, *tp2;
 {
        /*      Test if two types are assignment compatible.
                See Def 9.1.
        */
+       register struct type *tp;
 
        if (TstCompat(tp1, tp2)) return 1;
 
@@ -145,11 +146,16 @@ TstAssCompat(tp1, tp2)
        if (tp1 == char_type && tp2 == charc_type) return 1;
 
        if (tp1->tp_fund == T_ARRAY) {
+               /* check for string
+               */
                arith size;
 
-               if (! tp1->next) return 0;
+               if (!(tp = tp1->next)) return 0;
 
-               size = tp1->arr_ub - tp1->arr_lb + 1;
+               if (tp->tp_fund == T_SUBRANGE) {
+                       size = tp->sub_ub - tp->sub_lb + 1;
+               }
+               else    size = tp->enm_ncst;
                tp1 = tp1->arr_elem;
                if (tp1->tp_fund == T_SUBRANGE) tp1 = tp1->next;
                return

diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c
index f71cd5e..111ea18 100644 (file)
--- a/lang/m2/comp/walk.c
+++ b/lang/m2/comp/walk.c
@@ -69,10 +69,12 @@ WalkModule(module)
                Also generate code for its body.
        */
        register struct def *df = module->mod_vis->sc_scope->sc_def;
+       register struct scope *sc;
        struct scopelist *vis;
 
        vis = CurrVis;
        CurrVis = module->mod_vis;
+       sc = CurrentScope;
 
        if (!proclevel && module != Defined) {
                /* This module is a local module, but not within a
@@ -80,12 +82,12 @@ WalkModule(module)
                   variables. This is done by generating a "bss",
                   with label "_<modulenumber><modulename>".
                */
-               arith size = align(CurrentScope->sc_off, word_align);
+               arith size = align(sc->sc_off, word_align);
 
                if (size == 0) size = word_size;
                /* WHY ??? because we generated an INA for it ??? */
 
-               C_df_dnam(&(CurrentScope->sc_name[1]));
+               C_df_dnam(&(sc->sc_name[1]));
                C_bss_cst(size, (arith) 0, 0);
        }
        else if (CurrVis == Defined->mod_vis) {
@@ -104,22 +106,22 @@ WalkModule(module)
 
        /* Now, walk through it's local definitions
        */
-       WalkDef(CurrentScope->sc_def);
+       WalkDef(sc->sc_def);
 
        /* Now, generate initialization code for this module.
           First call initialization routines for modules defined within
           this module.
        */
-       CurrentScope->sc_off = 0;
+       sc->sc_off = 0;
        instructionlabel = 2;
        func_type = 0;
-       C_pro_narg(CurrentScope->sc_name);
+       C_pro_narg(sc->sc_name);
        DoProfil();
-       MkCalls(CurrentScope->sc_def);
+       MkCalls(sc->sc_def);
        WalkNode(module->mod_body, (label) 0);
        C_df_ilb((label) 1);
        C_ret(0);
-       C_end(-CurrentScope->sc_off);
+       C_end(-sc->sc_off);
        TmpClose();
 
        CurrVis = vis;
@@ -132,20 +134,22 @@ WalkProcedure(procedure)
                local definitions
        */
        struct scopelist *vis = CurrVis;
+       register struct scope *sc;
 
        proclevel++;
        CurrVis = procedure->prc_vis;
+       sc = CurrentScope;
        
-       WalkDef(CurrentScope->sc_def);
+       WalkDef(sc->sc_def);
 
        /* Generate code for this procedure
        */
-       C_pro_narg(CurrentScope->sc_name);
+       C_pro_narg(sc->sc_name);
        DoProfil();
        /* generate calls to initialization routines of modules defined within
           this procedure
        */
-       MkCalls(CurrentScope->sc_def);
+       MkCalls(sc->sc_def);
        return_expr_occurred = 0;
        instructionlabel = 2;
        func_type = procedure->df_type->next;
@@ -158,7 +162,7 @@ node_error(procedure->prc_body,"function procedure does not return a value");
                C_ret((int) align(func_type->tp_size, word_align));
        }
        else    C_ret(0);
-       C_end(-CurrentScope->sc_off);
+       C_end(-sc->sc_off);
        TmpClose();
        CurrVis = vis;
        proclevel--;
@@ -215,7 +219,7 @@ WalkNode(nd, lab)
 }
 
 WalkStat(nd, lab)
-       register struct node *nd;
+       struct node *nd;
        label lab;
 {
        /*      Walk through a statement, generating code for it.
@@ -224,8 +228,7 @@ WalkStat(nd, lab)
        */
        register struct node *left = nd->nd_left;
        register struct node *right = nd->nd_right;
-
-       if (options['p']) C_lin((arith) nd->nd_lineno);
+       register struct desig *pds = &Desig;
 
        if (!nd) {
                /* Empty statement
@@ -233,6 +236,8 @@ WalkStat(nd, lab)
                return;
        }
 
+       if (options['p']) C_lin((arith) nd->nd_lineno);
+
        if (nd->nd_class == Call) {
                if (chk_call(nd)) CodeCall(nd);
                return;
@@ -253,7 +258,7 @@ WalkStat(nd, lab)
                        break;
                }
 
-               CodeAssign(nd, &ds, &Desig);
+               CodeAssign(nd, &ds, pds);
                }
                break;
 
@@ -341,16 +346,16 @@ WalkStat(nd, lab)
                        wds.w_next = WithDesigs;
                        WithDesigs = &wds;
                        wds.w_scope = left->nd_type->rec_scope;
-                       if (Desig.dsg_kind != DSG_PFIXED) {
+                       if (pds->dsg_kind != DSG_PFIXED) {
                                /* In this case, we use a temporary variable
                                */
-                               CodeAddress(&Desig);
-                               Desig.dsg_kind = DSG_FIXED;
+                               CodeAddress(pds);
+                               pds->dsg_kind = DSG_FIXED;
                                /* Only for the store ... */
-                               Desig.dsg_offset = tmp = NewPtr();
-                               Desig.dsg_name = 0;
-                               CodeStore(&Desig, pointer_size);
-                               Desig.dsg_kind = DSG_PFIXED;
+                               pds->dsg_offset = tmp = NewPtr();
+                               pds->dsg_name = 0;
+                               CodeStore(pds, pointer_size);
+                               pds->dsg_kind = DSG_PFIXED;
                                /* the record is indirectly available */
                        }
                        wds.w_desig = Desig;
@@ -390,7 +395,7 @@ node_error(right, "type incompatibility in RETURN statement");
 }
 
 ExpectBool(nd, true_label, false_label)
-       struct node *nd;
+       register struct node *nd;
        label true_label, false_label;
 {
        /*      "nd" must indicate a boolean expression. Check this and