newer version
authorceriel <none@none>
Mon, 21 Apr 1986 17:27:06 +0000 (17:27 +0000)
committerceriel <none@none>
Mon, 21 Apr 1986 17:27:06 +0000 (17:27 +0000)
lang/m2/comp/Makefile
lang/m2/comp/declar.g
lang/m2/comp/def.H
lang/m2/comp/def.c
lang/m2/comp/defmodule.c
lang/m2/comp/enter.c
lang/m2/comp/main.c
lang/m2/comp/main.h
lang/m2/comp/program.g
lang/m2/comp/scope.C
lang/m2/comp/walk.c [new file with mode: 0644]

index c342b5e..6b2a4d7 100644 (file)
@@ -18,7 +18,7 @@ LOBJ =        tokenfile.o program.o declar.o expression.o statement.o
 COBJ = LLlex.o LLmessage.o char.o error.o main.o \
        symbol2str.o tokenname.o idf.o input.o type.o def.o \
        scope.o misc.o enter.o defmodule.o typequiv.o node.o \
-       cstoper.o chk_expr.o options.o
+       cstoper.o chk_expr.o options.o walk.o
 OBJ =  $(COBJ) $(LOBJ) Lpars.o
 GENFILES=      tokenfile.c \
        program.c declar.c expression.c statement.c \
@@ -81,7 +81,7 @@ depend:
 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
 LLmessage.o: LLlex.h Lpars.h idf.h
 char.o: class.h
-error.o: LLlex.h errout.h f_info.h input.h inputtype.h main.h node.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 scope.h standards.h tokenname.h type.h
 symbol2str.o: Lpars.h
 tokenname.o: Lpars.h idf.h tokenname.h
@@ -92,15 +92,16 @@ 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
-defmodule.o: LLlex.h debug.h def.h f_info.h idf.h input.h inputtype.h scope.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
 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 type.h
+walk.o: debug.h def.h main.h scope.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 misc.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
 statement.o: LLlex.h Lpars.h node.h type.h
 Lpars.o: Lpars.h
index 173104d..e28df72 100644 (file)
@@ -16,25 +16,22 @@ static char *RcsId = "$Header$";
 #include       "misc.h"
 #include       "main.h"
 
-static int     proclevel = 0;  /* nesting level of procedures */
-char *         sprint();
+int            proclevel = 0;  /* nesting level of procedures */
+extern char    *sprint();
 }
 
 ProcedureDeclaration
 {
        struct def *df;
-       char buf[256];
 } :
        ProcedureHeading(&df, D_PROCEDURE)
-                       { df->prc_level = proclevel++;
-                         if (DefinitionModule) {
-                               C_exp(sprint(buf, "%s_%s",
-                                               df->df_scope->sc_name,
-                                               df->df_idf->id_text));
-                         }
+                       {
+                         df->prc_level = proclevel++;
+
                        }
        ';' block(&(df->prc_body)) IDENT
-                       { match_id(dot.TOK_IDF, df->df_idf);
+                       {
+                         match_id(dot.TOK_IDF, df->df_idf);
                          df->prc_scope = CurrentScope;
                          close_scope(SC_CHKFORW);
                          proclevel--;
@@ -44,34 +41,22 @@ ProcedureDeclaration
 ProcedureHeading(struct def **pdf; int type;)
 {
        struct type *tp = 0;
-       struct type *tp1 = 0;
        struct paramlist *params = 0;
        register struct def *df;
+       struct def *DeclProc();
 } :
        PROCEDURE IDENT
-               { assert(type & (D_PROCEDURE | D_PROCHEAD));
-                 if (type == D_PROCHEAD) {
-                       df = define(dot.TOK_IDF, CurrentScope, type);
-                       df->for_node = MkNode(Name, NULLNODE, NULLNODE, &dot);
-                 }
-                 else {
-                       df = lookup(dot.TOK_IDF, CurrentScope);
-                       if (df && df->df_kind == D_PROCHEAD) {
-                               df->df_kind = type;
-                               tp1 = df->df_type;
-                       }
-                       else    df = define(dot.TOK_IDF, CurrentScope, type);
-                       df->prc_nbpar = 0;
-                       open_scope(OPENSCOPE);
-                 }
+               {
+                 df = DeclProc(type);
                }
        FormalParameters(type == D_PROCEDURE, &params, &tp, &(df->prc_nbpar))?
                {
-                 df->df_type = tp = construct_type(T_PROCEDURE, tp);
+                 tp = construct_type(T_PROCEDURE, tp);
                  tp->prc_params = params;
-                 if (tp1 && !TstTypeEquiv(tp, tp1)) {
+                 if (df->df_type && !TstTypeEquiv(tp, df->df_type)) {
 error("inconsistent procedure declaration for \"%s\"", df->df_idf->id_text); 
                  }
+                 df->df_type = tp;
                  *pdf = df;
                }
 ;
@@ -120,7 +105,8 @@ FormalParameters(int doparams;
        ]?
        ')'
                        { *tp = 0; }
-       [       ':' qualident(D_TYPE|D_HTYPE|D_HIDDEN, &df, "type", (struct node **) 0)
+       [       ':' qualident(D_TYPE|D_HTYPE|D_HIDDEN, &df, "type",
+                                                       (struct node **) 0)
                        { *tp = df->df_type; }
        ]?
 ;
@@ -160,15 +146,15 @@ FormalType(struct type **tp;)
        [ ARRAY OF      { ARRAYflag = 1; }
        ]?
        qualident(D_TYPE|D_HTYPE|D_HIDDEN, &df, "type", (struct node **) 0)
-                       { if (ARRAYflag) {
-                               *tp = construct_type(T_ARRAY, NULLTYPE);
-                               (*tp)->arr_elem = df->df_type;
-                               (*tp)->tp_align = lcm(word_align, pointer_align);
-                               (*tp)->tp_size = align(pointer_size + 3*word_size,
-                                                       (*tp)->tp_align);
-                         }
-                         else  *tp = df->df_type;
-                       }
+               { if (ARRAYflag) {
+                       *tp = construct_type(T_ARRAY, NULLTYPE);
+                       (*tp)->arr_elem = df->df_type;
+                       (*tp)->tp_align = lcm(word_align, pointer_align);
+                       (*tp)->tp_size = align(pointer_size + word_size,
+                                               (*tp)->tp_align);
+                 }
+                 else  *tp = df->df_type;
+               }
 ;
 
 TypeDeclaration
@@ -188,7 +174,6 @@ TypeDeclaration
                              tp->tp_fund != T_POINTER) {
 error("Opaque type \"%s\" is not a pointer type", df->df_idf->id_text);
                          }
-
                        }
 ;
 
@@ -244,6 +229,7 @@ enumeration(struct type **ptp;)
                                error("Too many enumeration literals");
                        }
                        else {
+                               /* ??? This is crummy */
                                (*ptp)->tp_size = word_size;
                                (*ptp)->tp_align = word_align;
                        }
@@ -392,7 +378,7 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
                                { max = tcnt; tcnt = *cnt; }
        [
                '|' variant(scope, &tcnt, tp, palign)
-                               { if (tcnt > max) max = tcnt; }
+                               { if (tcnt > max) max = tcnt; tcnt = *cnt; }
        ]*
        [ ELSE FieldListSequence(scope, &tcnt, palign)
                                { if (tcnt > max) max = tcnt; }
index e208653..7ae1054 100644 (file)
@@ -6,18 +6,22 @@ struct module {
        arith mo_priority;      /* priority of a module */
        struct scope *mo_scope; /* scope of this module */
        struct node *mo_body;   /* body of this module */
+       int mo_number;          /* number of this module */
 #define mod_priority   df_value.df_module.mo_priority
 #define mod_scope      df_value.df_module.mo_scope
 #define mod_body       df_value.df_module.mo_body
+#define mod_number     df_value.df_module.mo_number
 };
 
 struct variable {
        arith va_off;           /* address or offset of variable */
+       char *va_name;          /* name of variable if given */
        char va_addrgiven;      /* an address was given in the program */
        char va_noreg;          /* may not be in a register */
        short va_number;        /* number of this variable in definition module
                                */
 #define var_off                df_value.df_variable.va_off
+#define var_name       df_value.df_variable.va_name
 #define var_addrgiven  df_value.df_variable.va_addrgiven
 #define var_noreg      df_value.df_variable.va_noreg
 #define var_number     df_value.df_variable.va_number
@@ -49,15 +53,14 @@ struct field {
 struct dfproc {
        struct scope *pr_scope; /* scope of procedure */
        short pr_level;         /* depth level of this procedure */
-       short pr_number;        /* number of this procedure in definition module
-                               */
+       char *pr_name;          /* name of this procedure */
        arith pr_nbpar;         /* number of bytes parameters */
        struct node *pr_body;   /* body of this procedure */
 #define prc_scope      df_value.df_proc.pr_scope
 #define prc_level      df_value.df_proc.pr_level
 #define prc_nbpar      df_value.df_proc.pr_nbpar
 #define prc_body       df_value.df_proc.pr_body
-#define prc_number     df_value.df_proc.pr_number
+#define prc_name       df_value.df_proc.pr_name
 };
 
 struct import {
@@ -68,8 +71,10 @@ struct import {
 struct dforward {
        struct scope *fo_scope;
        struct node *fo_node;
+       char *fo_name;
 #define for_node       df_value.df_forward.fo_node
 #define for_scope      df_value.df_forward.fo_scope
+#define for_name       df_value.df_forward.fo_name
 };
 
 struct def     {               /* list of definitions for a name */
index 809bb5e..c6f49f0 100644 (file)
@@ -6,6 +6,7 @@ static char *RcsId = "$Header$";
 #include       <em_arith.h>
 #include       <em_label.h>
 #include       <assert.h>
+
 #include       "main.h"
 #include       "def.h"
 #include       "type.h"
@@ -13,6 +14,7 @@ static char *RcsId = "$Header$";
 #include       "scope.h"
 #include       "LLlex.h"
 #include       "node.h"
+
 #include       "debug.h"
 
 struct def *h_def;             /* Pointer to free list of def structures */
@@ -77,6 +79,7 @@ define(id, scope, kind)
                                   already seen in a definition module
                                */
                                df->df_kind = kind;
+                               df->prc_name = df->for_name;
                                return df;
                        }
                        break;  
@@ -391,6 +394,56 @@ RemFromId(df)
        }
 }
 
+struct def *
+DeclProc(type)
+{
+       /*      A procedure is declared, either in a definition or a program
+               module. Create a def structure for it (if neccessary)
+       */
+       register struct def *df;
+       extern char *sprint(), *Malloc(), *strcpy();
+       static int nmcount = 0;
+       char buf[256];
+
+       assert(type & (D_PROCEDURE | D_PROCHEAD));
+
+       if (type == D_PROCHEAD) {
+               /* In a definition module
+               */
+               df = define(dot.TOK_IDF, CurrentScope, type);
+               df->for_node = MkNode(Name, NULLNODE, NULLNODE, &dot);
+               sprint(buf,"%s_%s",CurrentScope->sc_name,df->df_idf->id_text);
+               df->for_name = Malloc((unsigned) (strlen(buf)+1));
+               strcpy(df->for_name, buf);
+               C_exp(df->for_name);
+       }
+       else {
+               df = lookup(dot.TOK_IDF, CurrentScope);
+               if (df && df->df_kind == D_PROCHEAD) {
+                       /* C_exp already generated when we saw the definition
+                          in the definition module
+                       */
+                       df->df_kind = type;
+               }
+               else {
+                       df = define(dot.TOK_IDF, CurrentScope, type);
+                       if (CurrentScope != Defined->mod_scope) {
+                               sprint(buf, "_%d_%s", ++nmcount,
+                                       df->df_idf->id_text);
+                       }
+                       else    (sprint(buf, "%s_%s",df->df_scope->sc_name,
+                                               df->df_idf->id_text));
+                       df->prc_name = Malloc((unsigned)(strlen(buf)+1));
+                       strcpy(df->prc_name, buf);
+                       C_inp(buf);
+               }
+               df->prc_nbpar = 0;
+               open_scope(OPENSCOPE);
+       }
+
+       return df;
+}
+
 #ifdef DEBUG
 PrDef(df)
        register struct def *df;
index 7a26111..808ff84 100644 (file)
@@ -5,12 +5,15 @@ static char *RcsId = "$Header$";
 #include       <assert.h>
 #include       <em_arith.h>
 #include       <em_label.h>
+
 #include       "idf.h"
 #include       "input.h"
 #include       "scope.h"
 #include       "def.h"
 #include       "LLlex.h"
 #include       "f_info.h"
+#include       "main.h"
+
 #include       "debug.h"
 
 #ifdef DEBUG
index 76fbc32..36e3632 100644 (file)
@@ -96,14 +96,21 @@ EnterVarList(IdList, type, local)
        register struct node *IdList;
        struct type *type;
 {
+       /*      Enter a list of identifiers representing variables into the
+               name list. "type" represents the type of the variables.
+               "local" is set if the variables are declared local to a
+               procedure
+       */
        register struct def *df;
-       struct scope *scope;
+       register struct scope *scope;
+       char buf[256];
+       extern char *sprint(), *Malloc(), *strcpy();
 
+       scope = CurrentScope;
        if (local) {
                /* Find the closest enclosing open scope. This
                   is the procedure that we are dealing with
                */
-               scope = CurrentScope;
                while (scope->sc_scopeclosed) scope = scope->next;
        }
 
@@ -111,6 +118,8 @@ EnterVarList(IdList, type, local)
                df = define(IdList->nd_IDF, CurrentScope, D_VARIABLE);
                df->df_type = type;
                if (IdList->nd_left) {
+                       /* An address was supplied
+                       */
                        df->var_addrgiven = 1;
                        if (IdList->nd_left->nd_type != card_type) {
 node_error(IdList->nd_left,"Illegal type for address");
@@ -127,12 +136,23 @@ node_error(IdList->nd_left,"Illegal type for address");
                        df->var_off = off;
                        scope->sc_off = off;
                }
-               else if (DefinitionModule) {
-                       char buf[256];
-                       char *sprint();
-
-                       C_exa_dnam(sprint(buf,"%s_%s",df->df_scope->sc_name,
-                                               df->df_idf->id_text));
+               else if (!DefinitionModule &&
+                        CurrentScope != Defined->mod_scope) {  
+                       scope->sc_off = align(scope->sc_off, type->tp_align);
+                       df->var_off = scope->sc_off;
+                       scope->sc_off += type->tp_size;
+               }
+               else {
+                       sprint(buf,"%s_%s", df->df_scope->sc_name,
+                                           df->df_idf->id_text);
+                       df->var_name = Malloc((unsigned)(strlen(buf)+1));
+                       strcpy(df->var_name, buf);
+                       if (DefinitionModule) {
+                               C_exa_dnam(df->var_name);
+                       }
+                       else {
+                               C_ina_dnam(df->var_name);
+                       }
                }
                IdList = IdList->nd_right;
        }
index 491d9f8..cc69c3e 100644 (file)
@@ -5,18 +5,20 @@ static char *RcsId = "$Header$";
 #include       <system.h>
 #include       <em_arith.h>
 #include       <em_label.h>
+
 #include       "input.h"
 #include       "f_info.h"
 #include       "idf.h"
 #include       "LLlex.h"
 #include       "Lpars.h"
-#include       "debug.h"
 #include       "type.h"
 #include       "def.h"
 #include       "scope.h"
 #include       "standards.h"
 #include       "tokenname.h"
 
+#include       "debug.h"
+
 char   options[128];
 int    DefinitionModule; 
 int    SYSTEMModule = 0;
@@ -24,6 +26,7 @@ char  *ProgName;
 extern int err_occurred;
 char   *DEFPATH[128];
 char   *getenv();
+struct def *Defined;
 
 main(argc, argv)
        char *argv[];
@@ -45,7 +48,6 @@ main(argc, argv)
                return 1;
        }
 #ifdef DEBUG
-       print("MODULA-2 compiler -- Debug version\n");
        DO_DEBUG(1, debug("Debugging level: %d", options['D']));
 #endif DEBUG
        return !Compile(Nargv[1], Nargv[2]);
@@ -72,20 +74,25 @@ Compile(src, dst)
        init_types();
        add_standards();
 #ifdef DEBUG
-       if (options['l']) LexScan();
-       else
+       if (options['l']) {
+               LexScan();
+               return 1;
+       }
 #endif DEBUG
-       {
-               (void) open_scope(CLOSEDSCOPE);
-               GlobalScope = CurrentScope;
-               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();
+       (void) open_scope(CLOSEDSCOPE);
+       GlobalScope = CurrentScope;
+       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();
+       if (err_occurred) {
+               C_close();
+               return 0;
        }
+       WalkModule(Defined);
        C_close();
        if (err_occurred) return 0;
        return 1;
index fd4502b..04ca4ed 100644 (file)
@@ -12,3 +12,7 @@ extern int DefinitionModule;
 extern int SYSTEMModule;/* Flag indicating that we are handling the SYSTEM
                           module
                        */
+extern struct def *Defined;
+                       /* Definition structure of module defined in this
+                          compilation
+                       */
index a2c066c..1e74708 100644 (file)
@@ -6,6 +6,7 @@ static  char *RcsId = "$Header$";
 #include       <alloc.h>
 #include       <em_arith.h>
 #include       <em_label.h>
+
 #include       "main.h"
 #include       "idf.h"
 #include       "LLlex.h"
@@ -13,6 +14,7 @@ static  char *RcsId = "$Header$";
 #include       "def.h"
 #include       "type.h"
 #include       "node.h"
+
 #include       "debug.h"
 
 static int DEFofIMPL = 0;      /* Flag indicating that we are currently
@@ -20,9 +22,6 @@ static int DEFofIMPL = 0;     /* Flag indicating that we are currently
                                   implementation module currently being
                                   compiled
                                */
-short nmcount = 0;             /* count names in definition modules in order
-                                  to create suitable names in the object code
-                               */
 }
 /*
        The grammar as given by Wirth is already almost LL(1); the
@@ -47,27 +46,37 @@ ModuleDeclaration
 {
        struct idf *id;
        register struct def *df;
+       extern int proclevel;
+       static int modulecount = 0;
+       char buf[256];
+       extern char *sprint(), *Malloc(), *strcpy();
 } :
-       MODULE IDENT            {
-                                 id = dot.TOK_IDF;
-                                 df = define(id, CurrentScope, D_MODULE);
-                                 if (!df->mod_scope) { 
-                                       open_scope(CLOSEDSCOPE);
-                                       df->mod_scope = CurrentScope;
-                                 }
-                                 else  CurrentScope = df->mod_scope;
-                                 df->df_type = 
-                                       standard_type(T_RECORD, 0, (arith) 0);
-                                 df->df_type->rec_scope = df->mod_scope;
-                               }
+       MODULE IDENT    {
+                         id = dot.TOK_IDF;
+                         df = define(id, CurrentScope, D_MODULE);
+                         if (!df->mod_scope) { 
+                               open_scope(CLOSEDSCOPE);
+                               df->mod_scope = CurrentScope;
+                         }
+                         else  CurrentScope = df->mod_scope;
+                         df->df_type = standard_type(T_RECORD, 0, (arith) 0);
+                         df->df_type->rec_scope = df->mod_scope;
+                         df->mod_number = ++modulecount;
+                         sprint(buf, "__%d%s", df->mod_number, id->id_text);
+                         CurrentScope->sc_name =
+                               Malloc((unsigned) (strlen(buf) + 1));
+                         strcpy(CurrentScope->sc_name, buf);
+                         C_ina_dnam(&buf[1]);
+                         C_inp(buf);
+                       }
        priority(&(df->mod_priority))?
        ';'
        import(1)*
        export(0)?
        block(&(df->mod_body))
-       IDENT                   { close_scope(SC_CHKFORW|SC_CHKPROC);
-                                 match_id(id, dot.TOK_IDF);
-                               }
+       IDENT           { close_scope(SC_CHKFORW|SC_CHKPROC);
+                         match_id(id, dot.TOK_IDF);
+                       }
 ;
 
 priority(arith *pprio;)
@@ -75,12 +84,12 @@ priority(arith *pprio;)
        struct node *nd;
 } :
        '[' ConstExpression(&nd) ']'
-                               { if (!(nd->nd_type->tp_fund & T_INTORCARD)) {
-                                       node_error(nd, "Illegal priority");
-                                 }
-                                 *pprio = nd->nd_INT;
-                                 FreeNode(nd);
-                               }
+                       { if (!(nd->nd_type->tp_fund & T_INTORCARD)) {
+                               node_error(nd, "Illegal priority");
+                         }
+                         *pprio = nd->nd_INT;
+                         FreeNode(nd);
+                       }
 ;
 
 export(int def;)
@@ -90,7 +99,8 @@ export(int def;)
 } :
        EXPORT
        [
-               QUALIFIED       { QUALflag = 1; }
+               QUALIFIED
+                       { QUALflag = 1; }
        ]?
        IdentList(&ExportList) ';'
                        {
@@ -128,18 +138,19 @@ DefinitionModule
 {
        register struct def *df;
        struct idf *id;
-       int savnmcount = nmcount;
 } :
        DEFINITION
-       MODULE IDENT    { id = dot.TOK_IDF;
+       MODULE IDENT    { 
+                         id = dot.TOK_IDF;
                          df = define(id, GlobalScope, D_MODULE);
                          if (!SYSTEMModule) open_scope(CLOSEDSCOPE);
+                         if (!Defined) Defined = df;
                          df->mod_scope = CurrentScope;
+                         df->mod_number = 0;
                          CurrentScope->sc_name = id->id_text;
                          df->df_type = standard_type(T_RECORD, 0, (arith) 0);
                          df->df_type->rec_scope = df->mod_scope;
                          DefinitionModule++;
-                         nmcount = 0;
                          DO_DEBUG(1, debug("Definition module \"%s\" %d",
                                        id->id_text, DefinitionModule));
                        }
@@ -167,7 +178,6 @@ DefinitionModule
                          if (!SYSTEMModule) close_scope(SC_CHKFORW);
                          DefinitionModule--;
                          match_id(id, dot.TOK_IDF);
-                         nmcount = savnmcount;
                        }
        '.'
 ;
@@ -221,8 +231,10 @@ ProgramModule(int state;)
                  }
                  else {
                        df = define(id, CurrentScope, D_MODULE);
+                       Defined = df;
                        open_scope(CLOSEDSCOPE);
                        df->mod_scope = CurrentScope;
+                       df->mod_number = 0;
                  }
                }
        priority(&(df->mod_priority))?
index 8142ee4..4a448c7 100644 (file)
@@ -168,16 +168,31 @@ Reverse(pdf)
 {
        /*      Reverse the order in the list of definitions in a scope.
                This is neccesary because this list is built in reverse.
+               Also, while we're at it, remove uninteresting definitions
+               from this list. The only interesting definitions are:
+               D_MODULE, D_PROCEDURE, and D_PROCHEAD.
        */
        register struct def *df, *df1;
+#define INTERESTING D_MODULE|D_PROCEDURE|D_PROCHEAD
 
        df = 0;
        df1 = *pdf;
        while (df1) {
+               if (df1->df_kind & INTERESTING) break;
                df1 = df1->df_nextinscope;
+       }
+
+       if (!(*pdf = df1)) return;
+
+       while (df1) {
+               *pdf = df1;
+               df1 = df1->df_nextinscope;
+               while (df1) {
+                       if (df1->df_kind & INTERESTING) break;
+                       df1 = df1->df_nextinscope;
+               }
                (*pdf)->df_nextinscope = df;
                df = *pdf;
-               *pdf = df1;
        }
 }
 
diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c
new file mode 100644 (file)
index 0000000..d23bbdf
--- /dev/null
@@ -0,0 +1,142 @@
+/* P A R S E   T R E E   W A L K E R */
+
+static char *RcsId = "$Header$";
+
+/*     Routines to walk through parts of the parse tree, and generate
+       code for these parts.
+*/
+
+#include       <em_arith.h>
+#include       <em_label.h>
+#include       <assert.h>
+
+#include       "def.h"
+#include       "type.h"
+#include       "scope.h"
+#include       "main.h"
+#include       "LLlex.h"
+#include       "node.h"
+
+#include       "debug.h"
+
+extern arith   align();
+static int     prclev = 0;
+
+WalkModule(module)
+       register struct def *module;
+{
+       /*      Walk through a module, and all its local definitions.
+               Also generate code for its body.
+       */
+       register struct def *df = module->mod_scope->sc_def;
+       struct scope *scope;
+
+       scope = CurrentScope;
+       CurrentScope = module->mod_scope;
+       if (!prclev && module->mod_number) {
+               /* This module is a local module, but not within a
+                  procedure. Generate code to allocate storage for its
+                  variables
+               */
+               arith size = align(CurrentScope->sc_off, word_size);
+
+               if (size == 0) size = word_size;
+               C_df_dnam(&(CurrentScope->sc_name[1]));
+               C_bss_cst(size, (arith) 0, 0);
+       }
+       else if (CurrentScope == Defined->mod_scope) {
+               /* This module is the module currently being compiled.
+                  Again, generate code to allocate storage for its
+                  variables, which all have an explicit name.
+               */
+               while (df) {
+                       if (df->df_kind == D_VARIABLE) {
+                               C_df_dnam(df->var_name);
+                               C_bss_cst(df->df_type->tp_size, (arith) 0, 0);
+                       }
+                       df = df->df_nextinscope;
+               }
+       }
+
+       /* Now, walk through it's local definitions
+       */
+       WalkDef(CurrentScope->sc_def);
+
+       /* Now, generate initialization code for this module.
+          First call initialization routines for modules defined within
+          this module.
+       */
+       CurrentScope->sc_off = 0;
+       C_pro_narg(CurrentScope->sc_name);
+       MkCalls(CurrentScope->sc_def);
+       WalkNode(module->mod_body);
+       C_end(align(-CurrentScope->sc_off, word_size));
+
+       CurrentScope = scope;
+}
+
+WalkProcedure(procedure)
+       struct def *procedure;
+{
+       /*      Walk through the definition of a procedure and all its
+               local definitions
+       */
+       struct scope *scope = CurrentScope;
+       register struct def *df;
+
+       prclev++;
+       CurrentScope = procedure->prc_scope;
+       
+       WalkDef(CurrentScope->sc_def);
+
+       /* Generate code for this procedure
+       */
+       C_pro_narg(procedure->prc_name);
+       /* generate calls to initialization routines of modules defined within
+          this procedure
+       */
+       MkCalls(CurrentScope->sc_def);
+       WalkNode(procedure->prc_body);
+       C_end(align(-CurrentScope->sc_off, word_size));
+       CurrentScope = scope;
+       prclev--;
+}
+
+WalkDef(df)
+       register struct def *df;
+{
+       /*      Walk through a list of definitions
+       */
+       while (df) {
+               if (df->df_kind == D_MODULE) {
+                       WalkModule(df);
+               }
+               else if (df->df_kind == D_PROCEDURE) {
+                       WalkProcedure(df);
+               }
+               df = df->df_nextinscope;
+       }
+}
+
+MkCalls(df)
+       register struct def *df;
+{
+       /*      Generate calls to initialization routines of modules
+       */
+       while (df) {
+               if (df->df_kind == D_MODULE) {
+                       C_lxl((arith) 0);
+                       C_cal(df->df_scope->sc_name);
+               }
+               df = df->df_nextinscope;
+       }
+}
+
+WalkNode(nd)
+       struct node *nd;
+{
+       /*      Node "nd" represents either a statement or a statement list.
+               Generate code for it.
+       */
+       /* ??? */
+}