newer version

This commit is contained in:
ceriel 1986-04-21 17:27:06 +00:00
parent 6715e3b171
commit 674791bf91
11 changed files with 348 additions and 100 deletions

View 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

View 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; }

View 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 */

View 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;

View 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

View 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;
}

View 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
#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();
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();
if (err_occurred) {
C_close();
return 0;
}
WalkModule(Defined);
C_close();
if (err_occurred) return 0;
return 1;

View 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
*/

View 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))?

View 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;
}
}

142
lang/m2/comp/walk.c Normal file
View file

@ -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.
*/
/* ??? */
}