some minor bug fixes
authorceriel <none@none>
Mon, 1 Dec 1986 10:06:53 +0000 (10:06 +0000)
committerceriel <none@none>
Mon, 1 Dec 1986 10:06:53 +0000 (10:06 +0000)
15 files changed:
lang/m2/comp/LLlex.c
lang/m2/comp/LLmessage.c
lang/m2/comp/Makefile
lang/m2/comp/chk_expr.c
lang/m2/comp/code.c
lang/m2/comp/declar.g
lang/m2/comp/def.H
lang/m2/comp/enter.c
lang/m2/comp/main.c
lang/m2/comp/program.g
lang/m2/comp/scope.C
lang/m2/comp/scope.h
lang/m2/comp/tokenname.c
lang/m2/comp/type.c
lang/m2/comp/walk.c

index 902ed71..0a4f021 100644 (file)
@@ -411,8 +411,20 @@ again1:
                                /* Fall through */
                                
                        case End:
-                               *np++ = '\0';
-                               tk->TOK_INT = str2long(&buf[1], base);
+                               *np = '\0';
+                               if (np >= &buf[NUMSIZE]) {
+                                       tk->TOK_INT = 1;
+                                       lexerror("constant too long");
+                               }
+                               else {
+                                       np = &buf[1];
+                                       while (*np == '0') np++;
+                                       tk->TOK_INT = str2long(np, base);
+                                       if (strlen(np) > 14 /* ??? */ ||
+                                           tk->TOK_INT < 0) {
+lexwarning(W_ORDINARY, "overflow in constant");
+                                       }
+                               }
                                if (ch == 'C' && base == 8) {
                                        toktype = char_type;
                                        if (tk->TOK_INT<0 || tk->TOK_INT>255) {
index 7de4385..a638662 100644 (file)
 
 extern char            *symbol2str();
 extern struct idf      *gen_anon_idf();
-extern int             err_occurred;
 
 LLmessage(tk)
-       int tk;
+       register int tk;
 {
        if (tk > 0)     {
                /* if (tk > 0), it represents the token to be inserted.
                */
+               register struct token *dotp = &dot;
+
                error("%s missing", symbol2str(tk));
-               insert_token(tk);
+
+               aside = *dotp;
+
+               dotp->tk_symb = tk;
+
+               switch (tk)     {
+               /* The operands need some body */
+               case IDENT:
+                       dotp->TOK_IDF = gen_anon_idf();
+                       break;
+               case STRING:
+                       dotp->tk_data.tk_str = (struct string *)
+                                               Malloc(sizeof (struct string));
+                       dotp->TOK_SLE = 1;
+                       dotp->TOK_STR = Salloc("", 1);
+                       break;
+               case INTEGER:
+                       dotp->TOK_INT = 1;
+                       break;
+               case REAL:
+                       dotp->TOK_REL = Salloc("0.0", 4);
+                       break;
+               }
        }
        else if (tk  < 0) {
                error("garbage at end of program");
@@ -33,31 +56,3 @@ LLmessage(tk)
        else    error("%s deleted", symbol2str(dot.tk_symb));
 }
 
-insert_token(tk)
-       int tk;
-{
-       register struct token *dotp = &dot;
-
-       aside = *dotp;
-
-       dotp->tk_symb = tk;
-
-       switch (tk)     {
-       /* The operands need some body */
-       case IDENT:
-               dotp->TOK_IDF = gen_anon_idf();
-               break;
-       case STRING:
-               dotp->tk_data.tk_str = (struct string *)
-                                       Malloc(sizeof (struct string));
-               dotp->TOK_SLE = 1;
-               dotp->TOK_STR = Salloc("", 1);
-               break;
-       case INTEGER:
-               dotp->TOK_INT = 1;
-               break;
-       case REAL:
-               dotp->TOK_REL = Salloc("0.0", 4);
-               break;
-       }
-}
index d434e74..d62ebac 100644 (file)
@@ -141,8 +141,8 @@ type.o: LLlex.h const.h debug.h debugcst.h def.h idf.h maxset.h node.h scope.h t
 def.o: LLlex.h Lpars.h debug.h debugcst.h def.h idf.h main.h node.h scope.h type.h
 scope.o: LLlex.h debug.h debugcst.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 debug.h debugcst.h def.h idf.h main.h node.h scope.h type.h
-defmodule.o: LLlex.h Lpars.h debug.h debugcst.h def.h f_info.h idf.h input.h inputtype.h main.h node.h scope.h type.h
+enter.o: LLlex.h debug.h debugcst.h def.h idf.h main.h misc.h node.h scope.h type.h
+defmodule.o: LLlex.h Lpars.h debug.h debugcst.h def.h f_info.h idf.h input.h inputtype.h main.h misc.h node.h scope.h type.h
 typequiv.o: LLlex.h debug.h debugcst.h def.h node.h type.h warning.h
 node.o: LLlex.h debug.h debugcst.h def.h node.h type.h
 cstoper.o: LLlex.h Lpars.h debug.h debugcst.h idf.h node.h standards.h target_sizes.h type.h warning.h
index d97a51f..401571d 100644 (file)
@@ -994,23 +994,24 @@ ChkStandard(expp, left)
                /* Now, make it look like a call to ALLOCATE or DEALLOCATE */
                {
                        struct token dt;
+                       register struct token *tk = &dt;
                        struct node *nd;
 
-                       dt.TOK_INT = PointedtoType(left->nd_type)->tp_size;
-                       dt.tk_symb = INTEGER;
-                       dt.tk_lineno = left->nd_lineno;
+                       tk->TOK_INT = PointedtoType(left->nd_type)->tp_size;
+                       tk->tk_symb = INTEGER;
+                       tk->tk_lineno = left->nd_lineno;
                        nd = MkLeaf(Value, &dt);
                        nd->nd_type = card_type;
-                       dt.tk_symb = ',';
-                       arg->nd_right = MkNode(Link, nd, NULLNODE, &dt);
+                       tk->tk_symb = ',';
+                       arg->nd_right = MkNode(Link, nd, NULLNODE, tk);
                        /* Ignore other arguments to NEW and/or DISPOSE ??? */
 
                        FreeNode(expp->nd_left);
-                       dt.tk_symb = IDENT;
-                       dt.tk_lineno = expp->nd_left->nd_lineno;
-                       dt.TOK_IDF = str2idf(std == S_NEW ?
+                       tk->tk_symb = IDENT;
+                       tk->tk_lineno = expp->nd_left->nd_lineno;
+                       tk->TOK_IDF = str2idf(std == S_NEW ?
                                                "ALLOCATE" : "DEALLOCATE", 0);
-                       expp->nd_left = MkLeaf(Name, &dt);
+                       expp->nd_left = MkLeaf(Name, tk);
                }
                return ChkCall(expp);
 
@@ -1145,7 +1146,7 @@ ChkCast(expp, left)
 }
 
 TryToString(nd, tp)
-       struct node *nd;
+       register struct node *nd;
        struct type *tp;
 {
        /*      Try a coercion from character constant to string.
index bbef689..d415d7a 100644 (file)
@@ -401,16 +401,7 @@ CodeParameters(param, arg)
                return;
        }
        if (left_type->tp_fund == T_STRING) {
-               register arith szarg = WA(left_type->tp_size);
-               arith sz = WA(tp->tp_size);
-
-               if (szarg != sz) {
-                       /* null padding required */
-                       assert(szarg < sz);
-                       C_zer(sz - szarg);
-               }
-               CodeString(left);       /* push address of string */
-               C_loi(szarg);
+               CodePString(left, tp);
                return;
        }
        CodePExpr(left);
@@ -418,6 +409,22 @@ CodeParameters(param, arg)
        CodeCoercion(left_type, tp);
 }
 
+CodePString(nd, tp)
+       struct node *nd;
+       struct type *tp;
+{
+       arith szarg = WA(nd->nd_type->tp_size);
+       register arith zersz = WA(tp->tp_size) - szarg;
+
+       if (zersz) {
+               /* null padding required */
+               assert(zersz > 0);
+               C_zer(zersz);
+       }
+       CodeString(nd); /* push address of string */
+       C_loi(szarg);
+}
+
 CodeStd(nd)
        struct node *nd;
 {
@@ -731,8 +738,8 @@ CodeOper(expr, true_label, false_label)
                        C_cmi(tp->tp_size);
                        break;
                case T_POINTER:
-               case T_EQUAL:
                case T_HIDDEN:
+               case T_EQUAL:
                case T_CARDINAL:
                case T_INTORCARD:
                        C_cmu(tp->tp_size);
index c08bfe1..7e93eb9 100644 (file)
@@ -116,10 +116,15 @@ TypeDeclaration
 {
        struct def *df;
        struct type *tp;
+       struct node *nd;
 }:
-       IDENT           { df = define(dot.TOK_IDF, CurrentScope, D_TYPE); }
+       IDENT           { df = define(dot.TOK_IDF, CurrentScope, D_TYPE);
+                         nd = MkLeaf(Name, &dot);
+                       }
        '=' type(&tp)
-                       { DeclareType(df, tp); }
+                       { DeclareType(nd, df, tp);
+                         free_node(nd);
+                       }
 ;
 
 type(struct type **ptp;):
@@ -239,7 +244,11 @@ RecordType(struct type **ptp;)
                  close_scope(0);
                }
        FieldListSequence(scope, &size, &xalign)
-               { *ptp = standard_type(T_RECORD, xalign, size);
+               { if (size == 0) {
+                       warning(W_ORDINARY, "empty record declaration");
+                       size = 1;
+                 }
+                 *ptp = standard_type(T_RECORD, xalign, size);
                  (*ptp)->rec_scope = scope;
                }
        END
index a172531..d27f32c 100644 (file)
@@ -1,7 +1,7 @@
 /* I D E N T I F I E R   D E S C R I P T O R   S T R U C T U R E */
 
 struct module {
-       arith mo_priority;      /* priority of a module */
+       struct node *mo_priority;/* priority of a module */
        struct scopelist *mo_vis;/* scope of this module */
        struct node *mo_body;   /* body of this module */
 #define mod_priority   df_value.df_module.mo_priority
index 0680a0b..52debbc 100644 (file)
@@ -15,6 +15,7 @@
 #include       "LLlex.h"
 #include       "node.h"
 #include       "main.h"
+#include       "misc.h"
 
 struct def *
 Enter(name, kind, type, pnam)
@@ -351,14 +352,8 @@ EnterExportList(Idlist, qualified)
                                }
                                if (df1->df_kind == D_HIDDEN &&
                                    df->df_kind == D_TYPE) {
-                                       if (df->df_type->tp_fund != T_POINTER) {
-                                               node_error(idlist,
-"opaque type \"%s\" is not a pointer type",
-                                                       df->df_idf->id_text);
-                                       }
-                                       assert(df1->df_type->next == NULLTYPE);
+                                       DeclareType(idlist, df1, df->df_type);
                                        df1->df_kind = D_TYPE;
-                                       df1->df_type->next = df->df_type;
                                        continue;
                                }
                        }
@@ -379,6 +374,7 @@ EnterFromImportList(Idlist, FromDef, FromId)
        register struct node *idlist = Idlist;
        register struct scopelist *vis;
        register struct def *df;
+       char *module_name = FromDef->df_idf->id_text;
        int forwflag = 0;
 
        switch(FromDef->df_kind) {
@@ -399,27 +395,31 @@ EnterFromImportList(Idlist, FromDef, FromId)
        case D_MODULE:
                vis = FromDef->mod_vis;
                if (vis == CurrVis) {
-node_error(FromId, "cannot import from current module \"%s\"",
-                               FromDef->df_idf->id_text);
+node_error(FromId, "cannot import from current module \"%s\"", module_name);
                        return;
                }
                break;
        default:
-node_error(FromId, "identifier \"%s\" does not represent a module",
-                      FromDef->df_idf->id_text);
+node_error(FromId,"identifier \"%s\" does not represent a module",module_name);
                return;
        }
 
        for (; idlist; idlist = idlist->next) {
                if (forwflag) df = ForwDef(idlist, vis->sc_scope);
                else if (! (df = lookup(idlist->nd_IDF, vis->sc_scope, 1))) {
-                   not_declared("identifier", idlist, " in qualifying module");
-                   df = define(idlist->nd_IDF,vis->sc_scope,D_ERROR);
+                       if (! is_anon_idf(idlist->nd_IDF)) {
+                               node_error(idlist,
+                       "identifier \"%s\" not declared in module \"%s\"",
+                                       idlist->nd_IDF->id_text,
+                                       module_name);
+                       }
+                       df = define(idlist->nd_IDF,vis->sc_scope,D_ERROR);
                }
                else if (! (df->df_flags & (D_EXPORTED|D_QEXPORTED))) {
                        node_error(idlist,
-                       "identifier \"%s\" not exported from qualifying module",
-                       idlist->nd_IDF->id_text);
+                       "identifier \"%s\" not exported from module \"%s\"",
+                       idlist->nd_IDF->id_text,
+                       module_name);
                        df->df_flags |= D_QEXPORTED;
                }
                DoImport(df, CurrentScope);
index 10c44f0..babf468 100644 (file)
@@ -81,15 +81,15 @@ Compile(src, dst)
                return 1;
        }
 #endif DEBUG
-       open_scope(CLOSEDSCOPE);
-       GlobalScope = CurrentScope;
+       open_scope(OPENSCOPE);
+       GlobalVis = CurrVis;
+       close_scope(0);
        C_init(word_size, pointer_size);
        if (! C_open(dst)) fatal("could not open output file");
        C_magic();
        C_ms_emx(word_size, pointer_size);
        CompUnit();
        C_ms_src((arith) (LineNumber - 1), FileName);
-       close_scope(SC_REVERSE);
        if (!err_occurred) {
                C_exp(Defined->mod_vis->sc_scope->sc_name);
                WalkModule(Defined);
index f7eed0d..e80578c 100644 (file)
@@ -44,7 +44,7 @@ ModuleDeclaration
        int qualified;
 } :
        MODULE IDENT    { df = DefineLocalModule(dot.TOK_IDF); }
-       priority(&(df->mod_priority))?
+       priority(df)
        ';'
        import(1)*
        export(&qualified, &exportlist)?
@@ -57,19 +57,21 @@ ModuleDeclaration
                        }
 ;
 
-priority(arith *pprio;)
+priority(register struct def *df;)
 {
        register struct node *nd;
-       struct node *nd1;               /* &nd is illegal */
 } :
-       '[' ConstExpression(&nd1) ']'
-                       { nd = nd1;
-                         if (!(nd->nd_type->tp_fund & T_CARDINAL)) {
-                               node_error(nd, "illegal priority");
+       [
+               '[' ConstExpression(&(df->mod_priority)) ']'
+                       { if (!(df->mod_priority->nd_type->tp_fund &
+                               T_CARDINAL)) {
+                               node_error(df->mod_priority,
+                                          "illegal priority");
                          }
-                         *pprio = nd->nd_INT;
-                         FreeNode(nd);
                        }
+       |
+                       { df->mod_priority = 0; }
+       ]
 ;
 
 export(int *QUALflag; struct node **ExportList;):
@@ -121,7 +123,7 @@ DefinitionModule
                          if (!Defined) Defined = df;
                          CurrentScope->sc_name = df->df_idf->id_text;
                          df->mod_vis = CurrVis;
-                         df->df_type = standard_type(T_RECORD, 1, (arith) 0);
+                         df->df_type = standard_type(T_RECORD, 1, (arith) 1);
                          df->df_type->rec_scope = df->mod_vis->sc_scope;
                          DefinitionModule++;
                        }
@@ -194,14 +196,14 @@ ProgramModule
                        RemoveImports(&(CurrentScope->sc_def));
                  }
                  else {
-                       Defined = df = define(dot.TOK_IDF, CurrentScope, D_MODULE);
+                       Defined = df = define(dot.TOK_IDF, GlobalScope, D_MODULE);
                        open_scope(CLOSEDSCOPE);
                        df->mod_vis = CurrVis;
                        CurrentScope->sc_name = "_M2M";
                  }
                  CurrentScope->sc_definedby = df;
                }
-       priority(&(df->mod_priority))?
+       priority(df)
        ';' import(0)*
        block(&(df->mod_body)) IDENT
                { close_scope(SC_CHKFORW|SC_CHKPROC|SC_REVERSE);
index e94f895..790e0ad 100644 (file)
@@ -14,8 +14,8 @@
 #include       "def.h"
 #include       "node.h"
 
-struct scope *PervasiveScope, *GlobalScope;
-struct scopelist *CurrVis;
+struct scope *PervasiveScope;
+struct scopelist *CurrVis, *GlobalVis;
 extern int proclevel;
 static struct scopelist *PervVis;
 extern char options[];
@@ -85,9 +85,14 @@ chk_proc(df)
 {
        /*      Called at scope closing. Check all definitions, and if one
                is a D_PROCHEAD, the procedure was not defined.
+               Also check that hidden types are defined.
        */
        while (df) {
-               if (df->df_kind == D_PROCHEAD) {
+               if (df->df_kind == D_HIDDEN) {
+                       error("hidden type \"%s\" not declared",
+                               df->df_idf->id_text);
+               }
+               else if (df->df_kind == D_PROCHEAD) {
                        /* A not defined procedure
                        */
                        error("procedure \"%s\" not defined",
@@ -121,6 +126,7 @@ node_error(df1->df_forw_node, "\"%s\" is not a type", df1->df_idf->id_text);
                        df1->df_forw_type->next = df->df_type;
                        FreeNode(df1->df_forw_node);
                        free_def(df1);
+                       continue;
                }
                else if (df->df_kind == D_FTYPE) {
                        df->df_kind = D_TYPE;
index 8e105b7..2fd385b 100644 (file)
@@ -30,13 +30,13 @@ struct scopelist {
 };
 
 extern struct scope
-       *PervasiveScope,
-       *GlobalScope;
+       *PervasiveScope;
 
 extern struct scopelist
-       *CurrVis;
+       *CurrVis, *GlobalVis;
 
 #define CurrentScope   (CurrVis->sc_scope)
+#define GlobalScope    (GlobalVis->sc_scope)
 #define enclosing(x)   ((x)->sc_encl)
 #define scopeclosed(x) ((x)->sc_scopeclosed)
 #define nextvisible(x) ((x)->next)             /* use with scopelists */
index 1de739f..223c2a6 100644 (file)
@@ -14,7 +14,7 @@
 struct tokenname tkspec[] =    {       /* the names of the special tokens */
        {IDENT, "identifier"},
        {STRING, "string"},
-       {INTEGER, "integer"},
+       {INTEGER, "number"},
        {REAL, "real"},
        {0, ""}
 };
index 134cbec..d30e19e 100644 (file)
@@ -473,9 +473,10 @@ FreeType(tp)
        free_type(tp);
 }
 
-DeclareType(df, tp)
+DeclareType(nd, df, tp)
        register struct def *df;
        register struct type *tp;
+       struct node *nd;
 {
        /*      A type with type-description "tp" is declared and must
                be bound to definition "df".
@@ -486,7 +487,9 @@ DeclareType(df, tp)
 
        if (df->df_type && df->df_type->tp_fund == T_HIDDEN) {
                if (! (tp->tp_fund & (T_POINTER|T_HIDDEN|T_EQUAL))) {
-error("opaque type \"%s\" is not a pointer type", df->df_idf->id_text);
+                       node_error(nd,
+                                  "opaque type \"%s\" is not a pointer type",
+                                  df->df_idf->id_text);
                }
                df->df_type->next = tp;
                df->df_type->tp_fund = T_EQUAL;
@@ -495,7 +498,9 @@ error("opaque type \"%s\" is not a pointer type", df->df_idf->id_text);
                }
                if (tp == df->df_type) {
                        /* Circular definition! */
-error("opaque type \"%s\" has a circular definition", df->df_idf->id_text);
+                       node_error(nd,
+                                "opaque type \"%s\" has a circular definition",
+                                df->df_idf->id_text);
                }
        }
        else    df->df_type = tp;
index 4a6da47..4fce401 100644 (file)
@@ -34,10 +34,29 @@ label               data_label;
 static struct type *func_type;
 struct withdesig *WithDesigs;
 struct node    *Modules;
+static struct node     *priority;
 
 #define        NO_EXIT_LABEL   ((label) 0)
 #define RETURN_LABEL   ((label) 1)
 
+STATIC
+DoPriority()
+{
+       if (priority) {
+               C_loc(priority->nd_INT);
+               C_cal("_stackprio");
+               C_asp(word_size);
+       }
+}
+
+STATIC
+EndPriority()
+{
+       if (priority) {
+               C_cal("_unstackprio");
+       }
+}
+
 STATIC
 DoProfil()
 {
@@ -67,6 +86,7 @@ WalkModule(module)
        struct scopelist *savevis = CurrVis;
 
        CurrVis = module->mod_vis;
+       priority = module->mod_priority;
        sc = CurrentScope;
 
        /* Walk through it's local definitions
@@ -81,6 +101,7 @@ WalkModule(module)
        text_label = 1;         /* label at end of initialization routine */
        TmpOpen(sc);            /* Initialize for temporaries */
        C_pro_narg(sc->sc_name);
+       DoPriority();
        DoProfil();
        if (module == Defined) {
                /* Body of implementation or program module.
@@ -113,6 +134,7 @@ WalkModule(module)
        DO_DEBUG(options['X'], PrNode(module->mod_body, 0));
        WalkNode(module->mod_body, NO_EXIT_LABEL);
        C_df_ilb(RETURN_LABEL);
+       EndPriority();
        C_ret((arith) 0);
        C_end(-sc->sc_off);
        proclevel--;
@@ -146,6 +168,7 @@ WalkProcedure(procedure)
        /* Generate code for this procedure
        */
        C_pro_narg(sc->sc_name);
+       DoPriority();
        DoProfil();
        TmpOpen(sc);
 
@@ -277,6 +300,7 @@ WalkProcedure(procedure)
                        C_ass(word_size);
                }
                C_lae_dlb(func_res_label, (arith) 0);
+               EndPriority();
                C_ret(pointer_size);
        }
        else if (tp) {
@@ -292,6 +316,7 @@ WalkProcedure(procedure)
                        C_lal(retsav);
                        C_loi(func_res_size);
                }
+               EndPriority();
                C_ret(func_res_size);
        }
        else    {
@@ -299,6 +324,7 @@ WalkProcedure(procedure)
                        C_lol(StackAdjustment);
                        C_ass(word_size);
                }
+               EndPriority();
                C_ret((arith) 0);
        }
        if (StackAdjustment) FreeInt(StackAdjustment);
@@ -324,7 +350,7 @@ WalkDef(df)
                        WalkProcedure(df);
                        break;
                case D_VARIABLE:
-                       if (!proclevel) {
+                       if (!proclevel  && !df->var_addrgiven) {
                                C_df_dnam(df->var_name);
                                C_bss_cst(
                                        WA(df->df_type->tp_size),
@@ -554,11 +580,7 @@ node_error(right, "type incompatibility in RETURN statement");
                                break;
                        }
                        if (right->nd_type->tp_fund == T_STRING) {
-                               arith strsize = WA(right->nd_type->tp_size);
-
-                               C_zer(WA(func_type->tp_size) - strsize);
-                               CodePExpr(right);
-                               C_loi(strsize);
+                               CodePString(right, func_type);
                        }
                        else    CodePExpr(right);
                }