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 \
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
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
#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--;
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, ¶ms, &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;
}
;
]?
')'
{ *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; }
]?
;
[ 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
tp->tp_fund != T_POINTER) {
error("Opaque type \"%s\" is not a pointer type", df->df_idf->id_text);
}
-
}
;
error("Too many enumeration literals");
}
else {
+ /* ??? This is crummy */
(*ptp)->tp_size = word_size;
(*ptp)->tp_align = word_align;
}
{ 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; }
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
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 {
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 */
#include <em_arith.h>
#include <em_label.h>
#include <assert.h>
+
#include "main.h"
#include "def.h"
#include "type.h"
#include "scope.h"
#include "LLlex.h"
#include "node.h"
+
#include "debug.h"
struct def *h_def; /* Pointer to free list of def structures */
already seen in a definition module
*/
df->df_kind = kind;
+ df->prc_name = df->for_name;
return df;
}
break;
}
}
+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;
#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
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;
}
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");
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;
}
#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;
extern int err_occurred;
char *DEFPATH[128];
char *getenv();
+struct def *Defined;
main(argc, argv)
char *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]);
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;
extern int SYSTEMModule;/* Flag indicating that we are handling the SYSTEM
module
*/
+extern struct def *Defined;
+ /* Definition structure of module defined in this
+ compilation
+ */
#include <alloc.h>
#include <em_arith.h>
#include <em_label.h>
+
#include "main.h"
#include "idf.h"
#include "LLlex.h"
#include "def.h"
#include "type.h"
#include "node.h"
+
#include "debug.h"
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
{
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;)
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;)
} :
EXPORT
[
- QUALIFIED { QUALflag = 1; }
+ QUALIFIED
+ { QUALflag = 1; }
]?
IdentList(&ExportList) ';'
{
{
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));
}
if (!SYSTEMModule) close_scope(SC_CHKFORW);
DefinitionModule--;
match_id(id, dot.TOK_IDF);
- nmcount = savnmcount;
}
'.'
;
}
else {
df = define(id, CurrentScope, D_MODULE);
+ Defined = df;
open_scope(CLOSEDSCOPE);
df->mod_scope = CurrentScope;
+ df->mod_number = 0;
}
}
priority(&(df->mod_priority))?
{
/* 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;
}
}
--- /dev/null
+/* 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.
+ */
+ /* ??? */
+}