newer version

diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile
index f4d00d0..c0b90a4 100644 (file)
--- a/lang/m2/comp/Makefile
+++ b/lang/m2/comp/Makefile
@@ -44,8 +44,8 @@ main: $(OBJ) Makefile
 clean:
        rm -f $(OBJ) $(GENFILES) LLfiles 
 
-lint:  LLfiles lintlist
-       lint $(INCLUDES) `cat lintlist`
+lint:  LLfiles hfiles
+       lint $(INCLUDES) -DNORCSID `sources $(OBJ)`
 
 tokenfile.g:   tokenname.c make.tokfile
        make.tokfile <tokenname.c >tokenfile.g
@@ -79,11 +79,11 @@ depend:
        make.allocd < $< > $@
 
 #AUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTO
-LLlex.o: LLlex.h Lpars.h class.h const.h f_info.h idf.h idfsize.h input.h inputtype.h numsize.h strsize.h type.h
+LLlex.o: LLlex.h Lpars.h class.h const.h debug.h f_info.h idf.h idfsize.h input.h inputtype.h numsize.h strsize.h type.h
 LLmessage.o: LLlex.h Lpars.h idf.h
 char.o: class.h
 error.o: LLlex.h debug.h errout.h f_info.h input.h inputtype.h main.h node.h
-main.o: LLlex.h Lpars.h debug.h def.h f_info.h idf.h input.h inputtype.h ndirs.h node.h scope.h standards.h tokenname.h type.h
+main.o: LLlex.h Lpars.h debug.h def.h f_info.h idf.h input.h inputtype.h ndir.h node.h scope.h standards.h tokenname.h type.h
 symbol2str.o: Lpars.h
 tokenname.o: Lpars.h idf.h tokenname.h
 idf.o: idf.h
@@ -92,17 +92,18 @@ type.o: LLlex.h const.h debug.h def.h idf.h maxset.h node.h target_sizes.h type.
 def.o: LLlex.h debug.h def.h idf.h main.h node.h scope.h type.h
 scope.o: LLlex.h debug.h def.h idf.h node.h scope.h type.h
 misc.o: LLlex.h f_info.h idf.h misc.h node.h
-enter.o: LLlex.h def.h idf.h main.h node.h scope.h type.h
+enter.o: LLlex.h debug.h def.h idf.h main.h node.h scope.h type.h
 defmodule.o: LLlex.h debug.h def.h f_info.h idf.h input.h inputtype.h main.h scope.h
 typequiv.o: def.h type.h
 node.o: LLlex.h debug.h def.h node.h type.h
-cstoper.o: LLlex.h Lpars.h idf.h node.h standards.h target_sizes.h type.h
+cstoper.o: LLlex.h Lpars.h debug.h idf.h node.h standards.h target_sizes.h type.h
 chk_expr.o: LLlex.h Lpars.h const.h debug.h def.h idf.h node.h scope.h standards.h type.h
 options.o: idfsize.h main.h ndir.h type.h
 walk.o: LLlex.h Lpars.h debug.h def.h main.h node.h scope.h type.h
+casestat.o: LLlex.h Lpars.h debug.h density.h node.h type.h
 tokenfile.o: Lpars.h
 program.o: LLlex.h Lpars.h debug.h def.h idf.h main.h node.h scope.h type.h
-declar.o: LLlex.h Lpars.h def.h idf.h main.h misc.h node.h scope.h type.h
-expression.o: LLlex.h Lpars.h const.h debug.h def.h idf.h node.h scope.h type.h
+declar.o: LLlex.h Lpars.h debug.h def.h idf.h main.h misc.h node.h scope.h type.h
+expression.o: LLlex.h Lpars.h const.h debug.h def.h idf.h node.h type.h
 statement.o: LLlex.h Lpars.h def.h idf.h node.h scope.h type.h
 Lpars.o: Lpars.h

diff --git a/lang/m2/comp/casestat.C b/lang/m2/comp/casestat.C
index babfd8b..b3ef54b 100644 (file)
--- a/lang/m2/comp/casestat.C
+++ b/lang/m2/comp/casestat.C
@@ -18,8 +18,6 @@ static char *RcsId = "$Header$";
 
 #include       "density.h"
 
-/* STATICALLOCDEF "caselist" */
-
 struct switch_hdr      {
        struct switch_hdr *next;
        label sh_break;
@@ -102,7 +100,7 @@ CaseCode(nd, exitlabel)
        tablabel = data_label();        /* the rom must have a label    */
        C_df_dlb(tablabel);
        if (sh->sh_default) C_rom_ilb(sh->sh_default);
-       else C_rom_ucon((arith) 0, pointer_size);
+       else C_rom_ucon("0", pointer_size);
        if (compact(sh->sh_nrofentries, sh->sh_lowerbd, sh->sh_upperbd)) {
                /* CSA */
 
@@ -253,8 +251,7 @@ AddOneCase(sh, node, lbl)
                */
                if (c1) {
                        if (c1->ce_value == ce->ce_value)       {
-                               node_error("multiple case entry for value %ld",
-                                       ce->ce_value);
+node_error(node, "multiple case entry for value %ld", ce->ce_value);
                                free_case_entry(ce);
                                return 0;
                        }

diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c
index ad59c7f..a0bc205 100644 (file)
--- a/lang/m2/comp/chk_expr.c
+++ b/lang/m2/comp/chk_expr.c
@@ -448,7 +448,7 @@ chk_designator(expp, flag)
                assert(expp->nd_right->nd_class == Name);
 
                if (! chk_designator(expp->nd_left,
-                                    (flag|HASSELECTORS)&DESIGNATOR)) return 0;
+                                    (flag|HASSELECTORS))) return 0;
 
                tp = expp->nd_left->nd_type;
 
@@ -633,7 +633,7 @@ node_error(expp, "IN operator: type of LHS not compatible with element type of R
        case '*':
                switch(tpl->tp_fund) {
                case T_POINTER:
-                       if (tpl != address_type) break;
+                       if (! chk_address(tpl, tpr)) break;
                        /* Fall through */
                case T_INTEGER:
                case T_CARDINAL:
@@ -669,7 +669,13 @@ node_error(expp, "IN operator: type of LHS not compatible with element type of R
 
        case DIV:
        case MOD:
-               if ((tpl->tp_fund & T_INTORCARD) || tpl == address_type) {
+               switch(tpl->tp_fund) {
+               case T_POINTER:
+                       if (! chk_address(tpl, tpr)) break;
+                       /* Fall through */
+               case T_INTEGER:
+               case T_CARDINAL:
+               case T_INTORCARD:
                        if (left->nd_class==Value && right->nd_class==Value) {
                                cstbin(expp);
                        }
@@ -718,7 +724,8 @@ node_error(expp, "IN operator: type of LHS not compatible with element type of R
                        return 1;
 
                case T_POINTER:
-                       if (expp->nd_symb == '=' ||
+                       if (chk_address(tpl, tpr) ||
+                           expp->nd_symb == '=' ||
                            expp->nd_symb == UNEQUAL ||
                            expp->nd_symb == '#') return 1;
                        break;
@@ -745,6 +752,22 @@ node_error(expp, "IN operator: type of LHS not compatible with element type of R
        return 0;
 }
 
+int
+chk_address(tpl, tpr)
+       register struct type *tpl, *tpr;
+{
+       
+       if (tpl == address_type) {
+               return tpr == address_type || tpr->tp_fund != T_POINTER;
+       }
+
+       if (tpr == address_type) {
+               return tpl->tp_fund != T_POINTER;
+       }
+
+       return 0;
+}
+
 int
 chk_uoper(expp)
        register struct node *expp;
@@ -769,6 +792,9 @@ chk_uoper(expp)
 
        case '-':
                if (tpr->tp_fund & T_INTORCARD) {
+                       if (tpr == intorcard_type) {
+                               expp->nd_type = int_type;
+                       }
                        if (right->nd_class == Value) {
                                cstunary(expp);
                        }

diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g
index 909e433..1adbccd 100644 (file)
--- a/lang/m2/comp/declar.g
+++ b/lang/m2/comp/declar.g
@@ -56,6 +56,12 @@ ProcedureHeading(struct def **pdf; int type;)
        PROCEDURE IDENT
                {
                  df = DeclProc(type);
+                 if (proclevel) {
+                       /* Room for static link
+                       */
+                       df->prc_nbpar = pointer_size;
+                 }
+                 else  df->prc_nbpar = 0;
                }
        FormalParameters(type == D_PROCEDURE, &params, &tp, &(df->prc_nbpar))?
                {

diff --git a/lang/m2/comp/def.c b/lang/m2/comp/def.c
index a5781cb..8006d58 100644 (file)
--- a/lang/m2/comp/def.c
+++ b/lang/m2/comp/def.c
@@ -477,7 +477,6 @@ DeclProc(type)
                        strcpy(CurrentScope->sc_name, buf);
                        C_inp(buf);
                }
-               df->prc_nbpar = 0;
        }
 
        return df;

diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c
index 812b48c..6e56b65 100644 (file)
--- a/lang/m2/comp/walk.c
+++ b/lang/m2/comp/walk.c
@@ -25,8 +25,6 @@ static char *RcsId = "$Header$";
 extern arith   align();
 static int     prclev = 0;
 static label   instructionlabel;
-static label   datalabel = 1;
-static label   return_label;
 static char    return_expr_occurred;
 static struct type *func_type;
 
@@ -39,7 +37,9 @@ text_label()
 label
 data_label()
 {
-       return datalabel++;
+       static label    datalabel = 0;
+
+       return ++datalabel;
 }
 
 WalkModule(module)
@@ -89,14 +89,13 @@ WalkModule(module)
           this module.
        */
        CurrentScope->sc_off = 0;
-       instructionlabel = 1;
-       return_label = instructionlabel++;
+       instructionlabel = 2;
        func_type = 0;
        C_pro_narg(CurrentScope->sc_name);
        MkCalls(CurrentScope->sc_def);
        WalkNode(module->mod_body, (label) 0);
-       C_df_ilb(return_label);
-       C_ret((label) 0);
+       C_df_ilb((label) 1);
+       C_ret(0);
        C_end(align(-CurrentScope->sc_off, word_align));
 
        CurrVis = vis;
@@ -121,15 +120,20 @@ WalkProcedure(procedure)
        /* generate calls to initialization routines of modules defined within
           this procedure
        */
-       return_label = 1;
+       MkCalls(CurrentScope->sc_def);
+       return_expr_occurred = 0;
        instructionlabel = 2;
        func_type = procedure->df_type->next;
-       MkCalls(CurrentScope->sc_def);
        WalkNode(procedure->prc_body, (label) 0);
-       C_df_ilb(return_label);
-       if (func_type) C_ret((arith) align(func_type->tp_size, word_align));
-       else C_ret((arith) 0);
-       C_end(align(-CurrentScope->sc_off, word_size));
+       C_df_ilb((label) 1);
+       if (func_type) {
+               if (! return_expr_occurred) {
+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((int) align(-CurrentScope->sc_off, word_align));
        CurrVis = vis;
        prclev--;
 }
@@ -195,6 +199,12 @@ WalkStat(nd, lab)
        register struct node *left = nd->nd_left;
        register struct node *right = nd->nd_right;
 
+       if (!nd) {
+               /* Empty statement
+               */
+               return;
+       }
+
        if (nd->nd_class == Call) {
                if (chk_call(nd)) CodeCall(nd);
                return;
@@ -204,8 +214,8 @@ WalkStat(nd, lab)
 
        switch(nd->nd_symb) {
        case BECOMES:
-               WalkDesignator(left);
                WalkExpr(right);
+               WalkDesignator(left);   /* May we do it in this order??? */
 
                if (! TstAssCompat(left->nd_type, right->nd_type)) {
                        node_error(nd, "type incompatibility in assignment");
@@ -318,7 +328,7 @@ node_error(right, "type incompatibility in RETURN statement");
                        }
                        return_expr_occurred = 1;
                }
-               C_bra(return_label);
+               C_bra((label) 1);
                break;
 
        default: