many minor mods

diff --git a/lang/m2/comp/LLlex.c b/lang/m2/comp/LLlex.c
index 5309114..3337102 100644 (file)
--- a/lang/m2/comp/LLlex.c
+++ b/lang/m2/comp/LLlex.c
@@ -354,7 +354,10 @@ again:
 
                if (ch == EOI) eofseen = 1;
                else PushBack();
-               *tag++ = '\0';
+               *tag = '\0';
+               if (*(tag - 1) == '_') {
+                       lexerror("last character of an identifier may not be a '_'");
+               }
 
                tk->TOK_IDF = id = str2idf(buf, 1);
                return tk->tk_symb = id->id_reserved ? id->id_reserved : IDENT;

diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile
index 938708c..ee19ebd 100644 (file)
--- a/lang/m2/comp/Makefile
+++ b/lang/m2/comp/Makefile
@@ -292,6 +292,7 @@ node.o: LLlex.h
 node.o: debug.h
 node.o: debugcst.h
 node.o: def.h
+node.o: main.h
 node.o: nocross.h
 node.o: node.h
 node.o: target_sizes.h

diff --git a/lang/m2/comp/Version.c b/lang/m2/comp/Version.c
index e1b1e8c..3c092b7 100644 (file)
--- a/lang/m2/comp/Version.c
+++ b/lang/m2/comp/Version.c
@@ -1 +1 @@
-static char Version[] = "ACK Modula-2 compiler Version 0.36";
+static char Version[] = "ACK Modula-2 compiler Version 0.37";

diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c
index 58de781..88c1a7f 100644 (file)
--- a/lang/m2/comp/chk_expr.c
+++ b/lang/m2/comp/chk_expr.c
@@ -1407,7 +1407,6 @@ int (*ExprChkTable[])() = {
        done_before,
        NodeCrash,
        ChkExLinkOrName,
-       NodeCrash
 };
 
 int (*DesigChkTable[])() = {
@@ -1423,5 +1422,4 @@ int (*DesigChkTable[])() = {
        done_before,
        NodeCrash,
        ChkLinkOrName,
-       NodeCrash
 };

diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c
index 484cdfa..15f5211 100644 (file)
--- a/lang/m2/comp/code.c
+++ b/lang/m2/comp/code.c
@@ -359,7 +359,8 @@ CodeCall(nd)
                }
                else    C_lfr(sz);
        }
-       DoFilename(nd);
+       DoFilename();
+       DoLineno(nd);
 }
 
 CodeParameters(param, arg)
@@ -503,12 +504,12 @@ CodeStd(nd)
        case S_ABS:
                CodePExpr(left);
                if (tp->tp_fund == T_INTEGER) {
-                       if (tp->tp_size == int_size) C_cal("_absi");
-                       else    C_cal("_absl");
+                       if (tp->tp_size == int_size) C_cal("absi");
+                       else    C_cal("absl");
                }
                else if (tp->tp_fund == T_REAL) {
-                       if (tp->tp_size == float_size) C_cal("_absf");
-                       else    C_cal("_absd");
+                       if (tp->tp_size == float_size) C_cal("absf");
+                       else    C_cal("absd");
                }
                C_asp(tp->tp_size);
                C_lfr(tp->tp_size);
@@ -585,7 +586,7 @@ CodeStd(nd)
                }
 
        case S_HALT:
-               C_cal("_halt");
+               C_cal("halt");
                break;
 
        case S_INCL:
@@ -1026,7 +1027,7 @@ CodeEl(nd, tp)
                }
                else    C_loc((arith) (eltype->enm_ncst - 1));
                Operands(nd);
-               C_cal("_LtoUset");      /* library routine to fill set */
+               C_cal("LtoUset");       /* library routine to fill set */
                C_asp(5 * word_size);
        }
        else {
@@ -1060,7 +1061,9 @@ CodeDAddress(nd)
 
        register t_desig *designator = new_desig();
 
-       ChkForFOR(nd);
+       /* ChkForFOR(nd); ??? not quite: wrong for value conformant arrays,
+                         where the parameter is the for-loop control variable
+       */
        CodeDesig(nd, designator);
        CodeAddress(designator);
        free_desig(designator);

diff --git a/lang/m2/comp/def.c b/lang/m2/comp/def.c
index 9afcb53..544b09f 100644 (file)
--- a/lang/m2/comp/def.c
+++ b/lang/m2/comp/def.c
@@ -27,6 +27,16 @@
 #include       "Lpars.h"
 #include       "warning.h"
 
+STATIC
+internal(c)
+       register char *c;
+{
+       if (options['x']) {
+               C_exp(c);
+       }
+       else    C_inp(c);
+}
+
 STATIC
 DefInFront(df)
        register t_def *df;
@@ -256,7 +266,7 @@ DeclProc(type, id)
                        df->for_name = id->id_text;
                }
                else {
-                       sprint(buf,"_%s_%s",CurrentScope->sc_name,id->id_text);
+                       sprint(buf,"%s_%s",CurrentScope->sc_name,id->id_text);
                        df->for_name = Salloc(buf, (unsigned) (strlen(buf)+1));
                }
                if (CurrVis == Defined->mod_vis) {
@@ -281,10 +291,7 @@ DeclProc(type, id)
                        df = define(id, CurrentScope, type);
                        sprint(buf,"_%d_%s",++nmcount,id->id_text);
                        name = Salloc(buf, (unsigned)(strlen(buf)+1));
-                       if (options['x']) {
-                               C_exp(buf);
-                       }
-                       else    C_inp(buf);
+                       internal(buf);
                        df->df_flags |= D_DEFINED;
                }
                open_scope(OPENSCOPE);
@@ -330,7 +337,7 @@ DefineLocalModule(id)
        extern char *sprint();
        extern int proclevel;
 
-       sprint(buf, "_%d%s", ++modulecount, id->id_text);
+       sprint(buf, "_%d%s_", ++modulecount, id->id_text);
 
        if (!df->mod_vis) {     
                /* We never saw the name of this module before. Create a
@@ -355,11 +362,7 @@ DefineLocalModule(id)
        /* Generate code that indicates that the initialization procedure
           for this module is local.
        */
-       if (options['x']) {
-               C_exp(buf);
-       }
-       else    C_inp(buf);
-
+       internal(buf);
        return df;
 }
 

diff --git a/lang/m2/comp/defmodule.c b/lang/m2/comp/defmodule.c
index 2af9d43..abfe9eb 100644 (file)
--- a/lang/m2/comp/defmodule.c
+++ b/lang/m2/comp/defmodule.c
@@ -128,9 +128,8 @@ GetDefinitionModule(id, incr)
                                        register t_node *n;
                                        extern t_node *Modules;
 
-                                       n = dot2leaf(Name);
-                                       n->nd_IDF = id;
-                                       n->nd_symb = IDENT;
+                                       n = dot2leaf(Def);
+                                       n->nd_def = CurrentScope->sc_definedby;
                                        if (nd_end) nd_end->nd_left = n;
                                        else Modules = n;
                                        nd_end = n;

diff --git a/lang/m2/comp/desig.c b/lang/m2/comp/desig.c
index 958c14b..d55f4f2 100644 (file)
--- a/lang/m2/comp/desig.c
+++ b/lang/m2/comp/desig.c
@@ -214,7 +214,10 @@ CodeValue(ds, tp)
                        break;
                case USE_LOAD_STORE:
                        sz = WA(tp->tp_size);
-                       if (ds->dsg_kind != DSG_PFIXED) {
+#ifndef SQUEEZE
+                       if (ds->dsg_kind != DSG_PFIXED)
+#endif
+                       {
                                arith tmp = NewPtr();
 
                                CodeAddress(ds);
@@ -224,13 +227,15 @@ CodeValue(ds, tp)
                                LOL(tmp, pointer_size);
                                FreePtr(tmp);
                        }
+#ifndef SQUEEZE
                        else  {
                                CodeConst(-sz, (int) pointer_size);
                                C_ass(pointer_size);
                        }
+#endif
                        CodeAddress(ds);
                        CodeConst(tp->tp_size, (int) pointer_size);
-                       C_cal("_load");
+                       C_cal("load");
                        C_asp(pointer_size + pointer_size);
                        break;
                }
@@ -293,7 +298,7 @@ CodeStore(ds, tp)
                        break;
                case USE_LOAD_STORE:
                        CodeConst(tp->tp_size, (int) pointer_size);
-                       C_cal("_store");
+                       C_cal("store");
                        CodeConst(pointer_size + pointer_size + WA(tp->tp_size),
                                (int) pointer_size);
                        C_ass(pointer_size);
@@ -362,7 +367,7 @@ CodeMove(rhs, left, rtp)
                        CodeAddress(lhs);
                        C_loc(rtp->tp_size);
                        C_loc(tp->tp_size);
-                       C_cal("_StringAssign");
+                       C_cal("StringAssign");
                        C_asp(pointer_size + pointer_size + dword_size);
                        break;
                }
@@ -430,7 +435,7 @@ CodeMove(rhs, left, rtp)
                case USE_LOAD_STORE:
                case USE_LOI_STI:
                        CodeConst(tp->tp_size, (int) pointer_size);
-                       C_cal("_blockmove");
+                       C_cal("blockmove");
                        C_asp(3 * pointer_size);
                        break;
                }
@@ -543,6 +548,7 @@ CodeVarDesig(df, ds)
                those of an enclosing procedure, or it is global.
        */
        register t_scope *sc = df->df_scope;
+       int difflevel;
 
        /* Selections from a module are handled earlier, when identifying
           the variable, so ...
@@ -569,16 +575,16 @@ CodeVarDesig(df, ds)
                return;
        }
 
-       if (sc->sc_level != proclevel) {
+       if ((difflevel = proclevel - sc->sc_level) != 0) {
                /* the variable is local to a statically enclosing procedure.
                */
-               assert(proclevel > sc->sc_level);
+               assert(difflevel > 0);
 
                df->df_flags |= D_NOREG;
                if (df->df_flags & (D_VARPAR|D_VALPAR)) {
                        /* value or var parameter
                        */
-                       C_lxa((arith) (proclevel - sc->sc_level));
+                       C_lxa((arith) difflevel);
                        if ((df->df_flags & D_VARPAR) ||
                            IsConformantArray(df->df_type)) {
                                /* var parameter or conformant array.
@@ -592,7 +598,7 @@ CodeVarDesig(df, ds)
                                return;
                        }
                }
-               else    C_lxl((arith) (proclevel - sc->sc_level));
+               else    C_lxl((arith) difflevel);
                ds->dsg_kind = DSG_PLOADED;
                ds->dsg_offset = df->var_off;
                return;
@@ -644,23 +650,26 @@ CodeDesig(nd, ds)
                CodeDesig(nd->nd_left, ds);
                CodeAddress(ds);
                CodePExpr(nd->nd_right);
+               nd = nd->nd_left;
 
                /* Now load address of descriptor
                */
-               if (IsConformantArray(nd->nd_left->nd_type)) {
-                       assert(nd->nd_left->nd_class == Def);
+               if (IsConformantArray(nd->nd_type)) {
+                       arith off;
+                       assert(nd->nd_class == Def);
 
-                       df = nd->nd_left->nd_def;
+                       df = nd->nd_def;
+                       off = df->var_off + pointer_size;
                        if (proclevel > df->df_scope->sc_level) {
                            C_lxa((arith) (proclevel - df->df_scope->sc_level));
-                           C_adp(df->var_off + pointer_size);
+                           C_adp(off);
                        }
-                       else    C_lal(df->var_off + pointer_size);
+                       else    C_lal(off);
                }
                else    {
-                       C_loc(nd->nd_left->nd_type->arr_low);
+                       C_loc(nd->nd_type->arr_low);
                        C_sbu(int_size);
-                       c_lae_dlb(nd->nd_left->nd_type->arr_descr);
+                       c_lae_dlb(nd->nd_type->arr_descr);
                }
                if (options['A']) {
                        C_cal("rcka");
@@ -671,7 +680,8 @@ CodeDesig(nd, ds)
        case Arrow:
                assert(nd->nd_symb == '^');
 
-               CodeDesig(nd->nd_right, ds);
+               nd = nd->nd_right;
+               CodeDesig(nd, ds);
                switch(ds->dsg_kind) {
                case DSG_LOADED:
                        ds->dsg_kind = DSG_PLOADED;
@@ -680,7 +690,7 @@ CodeDesig(nd, ds)
                case DSG_INDEXED:
                case DSG_PLOADED:
                case DSG_PFIXED:
-                       CodeValue(ds, nd->nd_right->nd_type);
+                       CodeValue(ds, nd->nd_type);
                        ds->dsg_kind = DSG_PLOADED;
                        ds->dsg_offset = 0;
                        break;

diff --git a/lang/m2/comp/enter.c b/lang/m2/comp/enter.c
index 7b74733..d1c29d4 100644 (file)
--- a/lang/m2/comp/enter.c
+++ b/lang/m2/comp/enter.c
@@ -160,7 +160,7 @@ EnterVarList(Idlist, type, local)
                                df->var_name = df->df_idf->id_text;
                        }
                        else {
-                               sprint(buf,"_%s_%s", sc->sc_scope->sc_name,
+                               sprint(buf,"%s_%s", sc->sc_scope->sc_name,
                                            df->df_idf->id_text);
                                df->var_name = Salloc(buf,
                                                (unsigned)(strlen(buf)+1));

diff --git a/lang/m2/comp/program.g b/lang/m2/comp/program.g
index 8ca5628..588bfa9 100644 (file)
--- a/lang/m2/comp/program.g
+++ b/lang/m2/comp/program.g
@@ -128,7 +128,9 @@ DefinitionModule
        int             dummy;
        extern t_idf    *DefId;
        extern int      ForeignFlag;
+       extern char     *sprint();
        register t_scope *currscope = CurrentScope;
+       char buf[512];
 } :
        DEFINITION
        MODULE IDENT    { df = define(dot.TOK_IDF, GlobalScope, D_MODULE);
@@ -139,7 +141,8 @@ DefinitionModule
                                error("DEFINITION MODULE name is \"%s\", not \"%s\"",
                                        df->df_idf->id_text, DefId->id_text);
                          }
-                         currscope->sc_name = df->df_idf->id_text;
+                         sprint(buf, "_%s_", df->df_idf->id_text);
+                         currscope->sc_name = Salloc(buf, (unsigned) strlen(buf) + 1);
                          df->mod_vis = CurrVis;
                          df->df_type = standard_type(T_RECORD, 1, (arith) 1);
                          df->df_type->rec_scope = currscope;
@@ -214,7 +217,7 @@ ProgramModule
                        Defined = df = define(dot.TOK_IDF, GlobalScope, D_MODULE);
                        open_scope(CLOSEDSCOPE);
                        df->mod_vis = CurrVis;
-                       CurrentScope->sc_name = "_M2M";
+                       CurrentScope->sc_name = "__M2M_";
                        CurrentScope->sc_definedby = df;
                  }
                }

diff --git a/lang/m2/comp/tmpvar.C b/lang/m2/comp/tmpvar.C
index d90104e..0c2a5d8 100644 (file)
--- a/lang/m2/comp/tmpvar.C
+++ b/lang/m2/comp/tmpvar.C
@@ -63,7 +63,7 @@ TmpSpace(sz, al)
 
 STATIC arith
 NewTmp(plist, sz, al, regtype)
-       struct tmpvar **plist;
+       register struct tmpvar **plist;
        arith sz;
 {
        register arith offset;

diff --git a/lang/m2/comp/typequiv.c b/lang/m2/comp/typequiv.c
index 4aae86c..8e058ff 100644 (file)
--- a/lang/m2/comp/typequiv.c
+++ b/lang/m2/comp/typequiv.c
@@ -263,7 +263,7 @@ TstParCompat(parno, formaltype, VARflag, nd, edf)
 }
 
 CompatCheck(nd, tp, message, fc)
-       t_node **nd;
+       register t_node **nd;
        t_type *tp;
        char *message;
        int (*fc)();

diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c
index 7e9be7d..a8b0b09 100644 (file)
--- a/lang/m2/comp/walk.c
+++ b/lang/m2/comp/walk.c
@@ -74,18 +74,21 @@ LblWalkNode(lbl, nd, exit)
        WalkNode(nd, exit);
 }
 
+static arith tmpprio;
+
 STATIC
 DoPriority()
 {
        /*      For the time being (???), handle priorities by calls to
                the runtime system
        */
-       register t_node *pri = priority;
-
-       if (pri) {
-               C_loc(pri->nd_INT);
-               C_cal("_stackprio");
+       if (priority) {
+               tmpprio = NewInt();
+               C_loc(priority->nd_INT);
+               C_cal("stackprio");
                C_asp(word_size);
+               C_lfr(word_size);
+               C_stl(tmpprio);
        }
 }
 
@@ -93,7 +96,10 @@ STATIC
 EndPriority()
 {
        if (priority) {
-               C_cal("_unstackprio");
+               C_lol(tmpprio);
+               C_cal("unstackprio");
+               C_asp(word_size);
+               FreeInt(tmpprio);
        }
 }
 
@@ -113,8 +119,7 @@ DoLineno(nd)
        }
 }
 
-DoFilename(nd)
-       t_node *nd;
+DoFilename()
 {
        static label    filename_label = 0;
 
@@ -128,8 +133,6 @@ DoFilename(nd)
                }
 
                C_fil_dlb((label) 1, (arith) 0);
-
-               if (nd) DoLineno(nd);
        }
 }
 
@@ -160,7 +163,6 @@ WalkModule(module)
        TmpOpen(sc);            /* Initialize for temporaries */
        C_pro_narg(sc->sc_name);
        DoPriority();
-       DoFilename(module->mod_body);
        if (module == Defined) {
                /* Body of implementation or program module.
                   Call initialization routines of imported modules.
@@ -183,8 +185,9 @@ WalkModule(module)
                }
 
                for (; nd; nd = nd->nd_left) {
-                       C_cal(nd->nd_IDF->id_text);
+                       C_cal(nd->nd_def->mod_vis->sc_scope->sc_name);
                }
+               DoFilename();
        }
        WalkDefList(sc->sc_def, MkCalls);
        proclevel++;
@@ -227,7 +230,7 @@ WalkProcedure(procedure)
        */
        C_pro_narg(procscope->sc_name);
        DoPriority();
-       DoFilename(procedure->prc_body);
+       DoFilename();           /* ??? only when this procedure is exported? */
        TmpOpen(procscope);
 
        func_type = tp = RemoveEqual(ResultType(procedure->df_type));
@@ -300,14 +303,14 @@ WalkProcedure(procedure)
                                }
                                /* First compute new stackpointer */
                                C_lal(param->par_def->var_off);
-                               C_cal("_new_stackptr");
+                               C_cal("new_stackptr");
                                C_asp(pointer_size);
                                C_lfr(pointer_size);
                                C_str((arith) 1);
                                                /* adjusted stack pointer */
                                LOL(param->par_def->var_off, pointer_size);
                                                /* push source address */
-                               C_cal("_copy_array");
+                               C_cal("copy_array");
                                                /* copy */
                                C_asp(pointer_size);
                        }
@@ -445,13 +448,13 @@ WalkStat(nd, exit_label)
        assert(nd->nd_class == Stat);
 
        DoLineno(nd);
-       if (nd->nd_flags & ROPTION) options['R'] = 1;
-       if (nd->nd_flags & AOPTION) options['A'] = 1;
+       options['R'] = (nd->nd_flags & ROPTION);
+       options['A'] = (nd->nd_flags & AOPTION);
        switch(nd->nd_symb) {
        case '(':
                if (ChkCall(nd)) {
                        if (nd->nd_type != 0) {
-                               node_error(nd, "illegal function call");
+                               node_error(nd, "procedure call expected instead of function call");
                                break;
                        }
                        CodeCall(nd);
@@ -521,7 +524,7 @@ WalkStat(nd, exit_label)
        case FOR:
                {
                        arith tmp = NewInt();
-                       arith tmp2;
+                       arith tmp2 = 0;
                        register t_node *fnd;
                        int good_forvar;
                        label l1 = ++text_label;
@@ -575,7 +578,7 @@ WalkStat(nd, exit_label)
                        WalkNode(right, exit_label);
                        nd->nd_def->df_flags &= ~D_FORLOOP;
                        if (good_forvar) {
-                               if (! options['R']) {
+                               if (tmp2 != 0) {
                                        label x = ++text_label;
                                        C_lol(tmp2);
                                        ForLoopVarExpr(nd);