safety commit, newer version

diff --git a/lang/m2/comp/LLlex.c b/lang/m2/comp/LLlex.c
index a677010..d003cc7 100644 (file)
--- a/lang/m2/comp/LLlex.c
+++ b/lang/m2/comp/LLlex.c
@@ -196,7 +196,7 @@ again:
                        PushBack(ch);
                *tg++ = '\0';
 
-               id = tk->TOK_IDF = str2idf(buf, 1);
+               tk->TOK_IDF = id = str2idf(buf, 1);
                if (!id) fatal("Out of memory");
                return tk->tk_symb = id->id_reserved ? id->id_reserved : IDENT;
        }

diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile
index 2a2bd1f..653a2fa 100644 (file)
--- a/lang/m2/comp/Makefile
+++ b/lang/m2/comp/Makefile
@@ -75,12 +75,12 @@ tokenname.o: Lpars.h idf.h tokenname.h
 idf.o: idf.h
 input.o: f_info.h input.h
 type.o: Lpars.h def.h def_sizes.h idf.h type.h
-def.o: Lpars.h def.h idf.h main.h scope.h
+def.o: Lpars.h debug.h def.h idf.h main.h scope.h
 scope.o: debug.h scope.h
 misc.o: LLlex.h f_info.h idf.h misc.h
-enter.o: def.h idf.h scope.h type.h
+enter.o: def.h idf.h misc.h scope.h type.h
 tokenfile.o: Lpars.h
-program.o: LLlex.h Lpars.h idf.h main.h misc.h scope.h
+program.o: LLlex.h Lpars.h def.h idf.h main.h misc.h scope.h type.h
 declar.o: LLlex.h Lpars.h def.h idf.h misc.h scope.h type.h
 expression.o: Lpars.h
 statement.o: Lpars.h

diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g
index 7217476..e88573d 100644 (file)
--- a/lang/m2/comp/declar.g
+++ b/lang/m2/comp/declar.g
@@ -5,6 +5,7 @@ static char *RcsId = "$Header$";
 
 #include       <em_arith.h>
 #include       <em_label.h>
+#include       <assert.h>
 #include       "idf.h"
 #include       "misc.h"
 #include       "LLlex.h"
@@ -15,29 +16,26 @@ static char *RcsId = "$Header$";
 
 ProcedureDeclaration
 {
-       register struct def *df;
+       struct def *df;
 } :
-       /* ProcedureHeading(&df) */
-       PROCEDURE IDENT
-                       { df = define(dot.TOK_IDF, CurrentScope, D_PROCEDURE);
-                         open_scope(OPENSCOPE, 0);
-                       }
-       FormalParameters?
+       ProcedureHeading(&df, D_PROCEDURE)
        ';' block IDENT
                        { match_id(dot.TOK_IDF, df->df_idf);
                          close_scope();
                        }
 ;
 
-ProcedureHeading
+ProcedureHeading(struct def **pdf; int type;)
 {
-       register struct def *df;
 } :
-       /*      Only used for definition modules
-       */
        PROCEDURE IDENT
-                       { df = define(dot.TOK_IDF, CurrentScope, D_PROCHEAD); }
-       FormalParameters?
+                       { assert(type == D_PROCEDURE || type == D_PROCHEAD);
+                         *pdf = define(dot.TOK_IDF, CurrentScope, D_PROCHEAD);
+                         if (type == D_PROCEDURE) {
+                               open_scope(OPENSCOPE, 0);
+                         }
+                       }
+       FormalParameters(type, &((*pdf)->df_type))?
 ;
 
 block:
@@ -56,13 +54,13 @@ declaration:
        ModuleDeclaration ';'
 ;
 
-FormalParameters:
-       '(' [ FPSection [ ';' FPSection ]* ]? ')'
+FormalParameters(int doparams; struct type **tp;) :
+       '(' [ FPSection(doparams) [ ';' FPSection(doparams)]* ]? ')'
        [ ':' qualident
        ]?
 ;
 
-FPSection
+FPSection(int doparams;)
 {
        struct id_list *FPList;
        int VARflag = 0;
@@ -72,6 +70,13 @@ FPSection
        ]?
        IdentList(&FPList) ':' FormalType
                        {
+                         if (doparams) {
+                               EnterIdList(FPList,
+                                           D_VARIABLE,
+                                           VARflag,
+                                           (struct type *) 0   /* ???? */
+                               );
+                         }
                          FreeIdList(FPList);
                        }
 ;
@@ -82,10 +87,13 @@ FormalType:
 
 TypeDeclaration
 {
-       register struct def *df;
+       struct def *df;
+       struct idf *id;
 }:
-       IDENT           { df = define(dot.TOK_IDF, CurrentScope, D_TYPE); }
-       '=' type
+       IDENT           { id = dot.TOK_IDF; }
+       '=' type        { df = define(id, CurrentScope, D_TYPE);
+                         /* ???? */
+                       }
 ;
 
 type:
@@ -124,22 +132,29 @@ enumeration
        struct id_list *EnumList;
 } :
        '(' IdentList(&EnumList) ')'
+                       {
+                         EnterIdList(EnumList,
+                                     D_ENUM,
+                                     0,
+                                     (struct type *) 0 /* ???? */
+                         );
+                         FreeIdList(EnumList);
+                       }
+
 ;
 
 IdentList(struct id_list **p;)
 {
        register struct id_list *q = new_id_list();
 } :
-       IDENT                   { q->id_ptr = dot.TOK_IDF; }
+       IDENT                   { q->id_ptr = dot.TOK_IDF;  *p = q;}
        [
                ',' IDENT       { q->next = new_id_list();
                                  q = q->next;
                                  q->id_ptr = dot.TOK_IDF;
                                }
        ]*
-                               { q->next = 0;
-                                 *p = q;
-                               }
+                               { q->next = 0; }
 ;
 
 SubrangeType:
@@ -209,10 +224,13 @@ FormalTypeList:
 
 ConstantDeclaration
 {
-       register struct def *df;
+       struct def *df;
+       struct idf *id;
 }:
-       IDENT           { df = define(dot.TOK_IDF, CurrentScope, D_CONST); }
-       '=' ConstExpression
+       IDENT                   { id = dot.TOK_IDF; }
+       '=' ConstExpression     { df = define(id, CurrentScope, D_CONST);
+                                 /* ???? */
+                               }
 ;
 
 VariableDeclaration
@@ -224,4 +242,11 @@ VariableDeclaration
                ConstExpression
        ]?
        ':' type
+                       { EnterIdList(VarList,
+                                     D_VARIABLE,
+                                     0,
+                                     (struct type *) 0 /* ???? */
+                                    );
+                         FreeIdList(VarList);
+                       }
 ;

diff --git a/lang/m2/comp/def.H b/lang/m2/comp/def.H
index ea76413..ba3604d 100644 (file)
--- a/lang/m2/comp/def.H
+++ b/lang/m2/comp/def.H
@@ -4,6 +4,7 @@
 
 struct module {
        int mo_priority;        /* Priority of a module */
+       int mo_scope;           /* Scope of this module */
 };
 
 struct variable {

diff --git a/lang/m2/comp/def.c b/lang/m2/comp/def.c
index 336bee3..53e69b9 100644 (file)
--- a/lang/m2/comp/def.c
+++ b/lang/m2/comp/def.c
@@ -10,6 +10,7 @@ static char *RcsId = "$Header$";
 #include       "idf.h"
 #include       "main.h"
 #include       "scope.h"
+#include       "debug.h"
 
 struct def *h_def;             /* Pointer to free list of def structures */
 
@@ -23,6 +24,7 @@ define(id, scope, kind)
        */
        register struct def *df = lookup(id, scope->sc_scope);
 
+       DO_DEBUG(debug(3,"Defining identifier %s in scope %d", id->id_text, scope->sc_scope));
        if (    /* Already in this scope */
                df
           ||   /* A closed scope, and id defined in the pervasive scope */
@@ -46,7 +48,7 @@ define(id, scope, kind)
                        return df;
                        break;
                }
-               error("Identifier %s already declared", id->id_text);
+               error("Identifier \"%s\" already declared", id->id_text);
                return df;
        }
        df = new_def();
@@ -71,6 +73,7 @@ lookup(id, scope)
 
        df1 = 0;
        df = id->id_def;
+       DO_DEBUG(debug(3,"Looking for identifier %s in scope %d", id->id_text, scope));
        while (df) {
                if (df->df_scope == scope) {
                        if (df1) {
@@ -80,6 +83,7 @@ lookup(id, scope)
                        }
                        return df;
                }
+               df1 = df;
                df = df->next;
        }
        return 0;

diff --git a/lang/m2/comp/enter.c b/lang/m2/comp/enter.c
index dc1d311..6dcc048 100644 (file)
--- a/lang/m2/comp/enter.c
+++ b/lang/m2/comp/enter.c
@@ -2,16 +2,19 @@
 
 static char *RcsId = "$Header$";
 
+#include       <alloc.h>
 #include       <em_arith.h>
 #include       <em_label.h>
 #include       "idf.h"
 #include       "def.h"
 #include       "type.h"
 #include       "scope.h"
+#include       "misc.h"
 
 extern struct idf *str2idf();
 extern struct def *define();
 
+struct def *
 Enter(name, kind, type, pnam)
        char *name;
        struct type *type;
@@ -26,4 +29,27 @@ Enter(name, kind, type, pnam)
        if (kind == D_STDPROC || kind == D_STDFUNC) {
                df->df_value.df_stdname = pnam;
        }
+       return df;
+}
+
+EnterIdList(idlist, kind, flags, type)
+       register struct id_list *idlist;
+       struct type *type;
+{
+       register struct def *df;
+       struct def *last = 0;
+       int assval = 0;
+
+       while (idlist) {
+               df = define(idlist->id_ptr, CurrentScope, kind);
+               df->df_type = type;
+               df->df_flags = flags;
+               if (kind == D_ENUM) {
+                       df->df_value.df_enum.en_val = assval++;
+                       if (last) last->df_value.df_enum.en_next = df;
+                       last = df;
+               }
+               idlist = idlist->next;
+       }
+       if (last) last->df_value.df_enum.en_next = 0;
 }

diff --git a/lang/m2/comp/misc.H b/lang/m2/comp/misc.H
index 5ca8a00..82deee3 100644 (file)
--- a/lang/m2/comp/misc.H
+++ b/lang/m2/comp/misc.H
@@ -10,3 +10,5 @@ struct id_list {
 };
 
 /* ALLOCDEF "id_list" */
+
+#define is_anon_idf(x) ((x)->id_text[0] == '#')

diff --git a/lang/m2/comp/misc.c b/lang/m2/comp/misc.c
index 7afd720..7199fc1 100644 (file)
--- a/lang/m2/comp/misc.c
+++ b/lang/m2/comp/misc.c
@@ -17,7 +17,7 @@ match_id(id1, id2)
                first place, and if not, give an error message
        */
        if (id1 != id2 && !is_anon_idf(id1) && !is_anon_idf(id2)) {
-               error("Identifier \"%s\" does not match identifier \"%s\"",
+               error("Name \"%s\" does not match block name \"%s\"",
                      id1->id_text,
                      id2->id_text
                );
@@ -54,10 +54,3 @@ gen_anon_idf()
                        ++name_cnt, FileName, LineNumber);
        return str2idf(buff, 1);
 }
-
-int
-is_anon_idf(idf)
-       struct idf *idf;
-{
-       return idf->id_text[0] == '#';
-}

diff --git a/lang/m2/comp/program.g b/lang/m2/comp/program.g
index 662ba71..32e888f 100644 (file)
--- a/lang/m2/comp/program.g
+++ b/lang/m2/comp/program.g
@@ -5,11 +5,14 @@ static  char *RcsId = "$Header$";
 
 #include       <alloc.h>
 #include       <em_arith.h>
+#include       <em_label.h>
 #include       "idf.h"
 #include       "misc.h"
 #include       "main.h"
 #include       "LLlex.h"
 #include       "scope.h"
+#include       "def.h"
+#include       "type.h"
 }
 /*
        The grammar as given by Wirth is already almost LL(1); the
@@ -40,8 +43,13 @@ priority:
 export
 {
        struct id_list *ExportList;
+       int QUALflag = 0;
 } :
-       EXPORT QUALIFIED? IdentList(&ExportList) ';'
+       EXPORT
+       [
+               QUALIFIED       { QUALflag = 1; }
+       ]?
+       IdentList(&ExportList) ';'
                        {
                          FreeIdList(ExportList);
                        }
@@ -67,9 +75,16 @@ import(int local;)
                        }
 ;
 
-DefinitionModule:
+DefinitionModule
+{
+       struct def *df;
+} :
        DEFINITION      { state = DEFINITION; }
-       MODULE IDENT    { open_scope(CLOSEDSCOPE, 0); }
+       MODULE IDENT    { 
+                         df = define(dot.TOK_IDF, CurrentScope, D_MODULE);
+                         open_scope(CLOSEDSCOPE, 0);
+                         df->df_value.df_module.mo_scope = CurrentScope->sc_scope;
+                       }
        ';'
        import(0)* 
        /*      export?
@@ -80,7 +95,10 @@ DefinitionModule:
                        { close_scope(); }
 ;
 
-definition:
+definition
+{
+       struct def *df;
+} :
        CONST [ ConstantDeclaration ';' ]*
 |
        TYPE
@@ -98,13 +116,17 @@ definition:
 |
        VAR [ VariableDeclaration ';' ]*
 |
-       ProcedureHeading ';'
+       ProcedureHeading(&df, D_PROCHEAD) ';'
 ;
 
 ProgramModule:
        MODULE          { if (state != IMPLEMENTATION) state = PROGRAM; }
        IDENT           { if (state == IMPLEMENTATION) {
-                               /* Re-open scope ??? */
+                               /* ????
+                                  Read definition module,
+                                  Look for current identifier,
+                                  and find out its scope number
+                               */
                                open_scope(CLOSEDSCOPE, 0);
                          }
                          else  open_scope(CLOSEDSCOPE, 0);