d0p1/ack
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

newer version

Browse source
This commit is contained in:
ceriel 1986-05-16 17:15:36 +00:00
parent 15896e422c
commit a4887558b8
15 changed files with 270 additions and 37 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
lang/m2/comp/Makefile
View file

@ -99,7 +99,7 @@ node.o: LLlex.h debug.h def.h node.h type.h
cstoper.o: LLlex.h Lpars.h debug.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 main.h ndir.h type.h
walk.o: LLlex.h Lpars.h debug.h def.h main.h node.h scope.h type.h
walk.o: LLlex.h Lpars.h debug.h def.h desig.h main.h node.h scope.h type.h
casestat.o: LLlex.h Lpars.h debug.h density.h node.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

2
lang/m2/comp/chk_expr.c
View file

@ -461,6 +461,8 @@ chk_designator(expp, flag)
return 0;
}
else {
expp->nd_right->nd_class = Def;
expp->nd_right->nd_def = df;
expp->nd_type = df->df_type;
if (!(df->df_flags & (D_EXPORTED|D_QEXPORTED))) {
node_error(expp->nd_right,

6
lang/m2/comp/declar.g
View file

@ -33,7 +33,6 @@ ProcedureDeclaration
} :
ProcedureHeading(&df, D_PROCEDURE)
{
df->prc_level = proclevel++;
currentdef = df;
}
';' block(&(df->prc_body)) IDENT
@ -55,8 +54,9 @@ ProcedureHeading(struct def **pdf; int type;)
} :
PROCEDURE IDENT
{
if (type == D_PROCEDURE) proclevel++;
df = DeclProc(type);
if (proclevel) {
if (proclevel > 1) {
/* Room for static link
*/
df->prc_nbpar = pointer_size;
@ -242,7 +242,7 @@ enumeration(struct type **ptp;)
{
*ptp = standard_type(T_ENUMERATION, 1, (arith) 1);
EnterIdList(EnumList, D_ENUM, 0, *ptp,
CurrentScope, (arith *) 0);
CurrentScope, (arith *) 0);
FreeNode(EnumList);
if ((*ptp)->enm_ncst > 256) {
if (word_size == 1) {

9
lang/m2/comp/def.H
View file

@ -6,25 +6,18 @@ struct module {
arith mo_priority; /* priority of a module */
struct scopelist *mo_vis;/* 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_vis df_value.df_module.mo_vis
#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 constant {
@ -52,11 +45,9 @@ struct field {
struct dfproc {
struct scopelist *pr_vis; /* scope of procedure */
short pr_level; /* depth level of this procedure */
arith pr_nbpar; /* number of bytes parameters */
struct node *pr_body; /* body of this procedure */
#define prc_vis df_value.df_proc.pr_vis
#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
};

164
lang/m2/comp/desig.c Normal file
View file

@ -0,0 +1,164 @@
/* D E S I G N A T O R E V A L U A T I O N */
#ifndef NORCSID
static char *RcsId = "$Header$";
#endif
/* Code generation for designators.
This file contains some routines that generate code common to address
as well as value computations, and leave a description in a "desig"
structure. It also contains routines to load an address, load a value
or perform a store.
*/
#include "debug.h"
#include <em_arith.h>
#include <em_label.h>
#include <assert.h>
#include "type.h"
#include "def.h"
#include "scope.h"
#include "desig.h"
#include "LLlex.h"
#include "node.h"
CodeValue(ds, size)
register struct desig *ds;
{
/* Generate code to load the value of the designator described
in "ds"
*/
switch(ds->dsg_kind) {
case DSG_LOADED:
break;
case DSG_FIXED:
if (size == word_size) {
if (ds->dsg_name) {
C_loe_dnam(ds->dsg_name, ds->dsg_offset);
}
else C_lol(ds->dsg_offset);
break;
}
if (size == dwird_size) {
if (ds->dsg_name) {
C_lde_dnam(ds->dsg_name, ds->dsg_offset);
}
else C_ldl(ds->dsg_offset);
break;
}
/* Fall through */
case DSG_PLOADED:
case DSG_PFIXED:
CodeAddress(ds);
C_loi(size);
break;
case DSG_INDEXED:
C_lar(word_size);
break;
default:
assert(0);
}
ds->dsg_kind = DSG_LOADED;
}
CodeAddress(ds)
register struct desig *ds;
{
/* Generate code to load the address of the designator described
in "ds"
*/
switch(ds->dsg_kind) {
case DSG_PLOADED:
if (ds->dsg_offset) {
C_adp(ds->dsg_offset);
}
break;
case DSG_FIXED:
if (ds->dsg_name) {
C_lae_dnam(ds->dsg_name, ds->dsg_offset);
break;
}
C_lal(ds->dsg_offset);
break;
case DSG_PFIXED:
ds->dsg_kind = DSG_FIXED;
CodeValue(ds, pointer_size);
break;
case DSG_INDEXED:
C_aar(word_size);
break;
default:
assert(0);
break;
}
ds->dsg_offset = 0;
ds->dsg_kind = DSG_PLOADED;
}
CodeFieldDesig(df, ds)
register struct def *df;
register struct desig *ds;
{
/* Generate code for a field designator. Only the code common for
address as well as value computation is generated, and the
resulting information on where to find the designator is placed
in "ds". "df" indicates the definition of the field.
*/
register struct withdesig *wds;
if (ds->dsg_kind == DSG_INIT) {
/* In a WITH statement. We must find the designator in the
WITH statement, and act as if the field is a selection
of this designator.
So, first find the right WITH statement, which is the
first one of the proper record type.
Notice that the proper record type is recognized by its
scope indication.
*/
wds = WithDesigs;
assert(wds != 0);
while (wds->w_scope != df->df_scope) {
wds = wds->w_next;
assert(wds != 0);
}
/* Found it. Now, act like it was a selection.
*/
*ds = wds->w_desig;
}
switch(ds->dsg_kind) {
case DSG_PLOADED:
case DSG_FIXED:
ds->dsg_offset += df->fld_off;
break;
case DSG_PFIXED:
case DSG_INDEXED:
CodeAddress(ds);
ds->dsg_kind = PLOADED;
ds->dsg_offset = df->fld_off;
break;
default:
assert(0);
break;
}
}

53
lang/m2/comp/desig.h Normal file
View file

@ -0,0 +1,53 @@
/* D E S I G N A T O R D E S C R I P T I O N S */
/* $Header$ */
/* Generating code for designators is not particularly easy, especially if
you don't know wether you want the address or the value.
The next structure is used to generate code for designators.
It contains information on how to find the designator, after generation
of the code that is common to both address and value computations.
*/
struct desig {
int dsg_kind;
#define DSG_INIT 0 /* don't know anything yet */
#define DSG_LOADED 1 /* designator loaded on top of the stack */
#define DSG_PLOADED 2 /* designator accessible through pointer on
stack, possibly with an offset
*/
#define DSG_FIXED 3 /* designator directly accessible */
#define DSG_PFIXED 4 /* designator accessible through directly
accessible pointer
*/
#define DSG_INDEXED 5 /* designator accessible through array
operation. Address of array descriptor on
top of the stack, index beneath that, and
base address beneath that
*/
arith dsg_offset; /* contains an offset for PLOADED,
or for FIXED or PFIXED it contains an
offset from dsg_name, if it exists,
or from the current Local Base
*/
char *dsg_name; /* name of global variable, used for
FIXED and PFIXED
*/
};
/* The next structure describes the designator in a with-statement.
We have a linked list of them, as with-statements may be nested.
*/
struct withdesig {
struct withdesig *w_next;
struct scope *w_scope; /* scope in which fields of this record
reside
*/
struct desig *w_desig; /* a desig structure for this particular
designator
*/
};
extern struct withdesig *WithDesigs;
extern struct desig Desig;

11
lang/m2/comp/enter.c
View file

@ -105,7 +105,7 @@ EnterVarList(IdList, type, local)
/* 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
procedure.
*/
register struct def *df;
register struct scopelist *sc;
@ -143,14 +143,15 @@ node_error(IdList->nd_left,"Illegal type for address");
type->tp_align);
df->var_off = sc->sc_scope->sc_off;
}
else if (!DefinitionModule &&
CurrVis != Defined->mod_vis) {
else if (!DefinitionModule && CurrVis != Defined->mod_vis) {
/* variable list belongs to an internal global
module. Align offset and add size
module.
Align offset and add size
*/
sc->sc_scope->sc_off =
align(sc->sc_scope->sc_off, type->tp_align);
df->var_off = sc->sc_scope->sc_off;
df->var_name = 0;
sc->sc_scope->sc_off += type->tp_size;
}
else {
@ -160,6 +161,7 @@ node_error(IdList->nd_left,"Illegal type for address");
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);
}
@ -167,6 +169,7 @@ node_error(IdList->nd_left,"Illegal type for address");
C_ina_dnam(df->var_name);
}
}
IdList = IdList->nd_right;
}
}

2
lang/m2/comp/main.c
View file

@ -84,7 +84,7 @@ Compile(src, dst)
return 1;
}
#endif DEBUG
(void) open_scope(CLOSEDSCOPE);
open_scope(CLOSEDSCOPE);
GlobalScope = CurrentScope;
C_init(word_size, pointer_size);
if (! C_open(dst)) {

5
lang/m2/comp/options.c
View file

@ -64,7 +64,10 @@ DoOption(text)
switch (c) {
case 'w': /* word */
if (size != (arith)0) word_size = size;
if (size != (arith)0) {
word_size = size;
dword_size = 2 * size;
}
if (align != 0) word_align = align;
break;
case 'i': /* int */

12
lang/m2/comp/program.g
View file

@ -67,16 +67,18 @@ ModuleDeclaration
open_scope(CLOSEDSCOPE);
df->mod_vis = CurrVis;
}
else CurrVis = df->mod_vis;
else {
CurrVis = df->mod_vis;
CurrentScope->sc_level = proclevel;
}
df->df_type = standard_type(T_RECORD, 0, (arith) 0);
df->df_type->rec_scope = df->mod_vis->sc_scope;
df->mod_number = ++modulecount;
sprint(buf, "__%d%s", df->mod_number, id->id_text);
sprint(buf, "__%d%s", ++modulecount, id->id_text);
CurrentScope->sc_name =
Malloc((unsigned) (strlen(buf) + 1));
strcpy(CurrentScope->sc_name, buf);
C_ina_dnam(&buf[1]);
if (! proclevel) C_ina_dnam(&buf[1]);
C_inp(buf);
}
priority(&(df->mod_priority))?
@ -161,7 +163,6 @@ DefinitionModule
if (!SYSTEMModule) open_scope(CLOSEDSCOPE);
if (!Defined) Defined = df;
df->mod_vis = CurrVis;
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_vis->sc_scope;
@ -253,7 +254,6 @@ ProgramModule(int state;)
Defined = df;
open_scope(CLOSEDSCOPE);
df->mod_vis = CurrVis;
df->mod_number = 0;
CurrentScope->sc_name = id->id_text;
}
}

7
lang/m2/comp/scope.C
View file

@ -20,7 +20,7 @@ static char *RcsId = "$Header$";
struct scope *PervasiveScope, *GlobalScope;
struct scopelist *CurrVis;
static int scp_level;
extern int proclevel;
static struct scopelist *PervVis;
/* STATICALLOCDEF "scope" */
@ -36,7 +36,7 @@ open_scope(scopetype)
assert(scopetype == OPENSCOPE || scopetype == CLOSEDSCOPE);
sc->sc_scopeclosed = scopetype == CLOSEDSCOPE;
sc->sc_level = scp_level++;
sc->sc_level = proclevel;
sc->sc_forw = 0;
sc->sc_def = 0;
sc->sc_off = 0;
@ -57,7 +57,7 @@ init_scope()
sc->sc_scopeclosed = 0;
sc->sc_forw = 0;
sc->sc_def = 0;
sc->sc_level = scp_level++;
sc->sc_level = proclevel;
PervasiveScope = sc;
ls->next = 0;
ls->sc_encl = 0;
@ -228,7 +228,6 @@ close_scope(flag)
if (flag & SC_REVERSE) Reverse(&(sc->sc_def));
}
CurrVis = enclosing(CurrVis);
scp_level = CurrentScope->sc_level;
}
#ifdef DEBUG

2
lang/m2/comp/scope.h
View file

@ -27,8 +27,8 @@ struct scope {
struct scopelist {
struct scopelist *next;
struct scopelist *sc_encl;
struct scope *sc_scope;
struct scopelist *sc_encl;
};
extern struct scope

1
lang/m2/comp/type.H
View file

@ -112,6 +112,7 @@ extern int
extern arith
word_size,
dword_size,
int_size,
long_size,
float_size,

1
lang/m2/comp/type.c
View file

@ -34,6 +34,7 @@ int
arith
word_size = SZ_WORD,
dword_size = 2 * SZ_WORD,
int_size = SZ_INT,
long_size = SZ_LONG,
float_size = SZ_FLOAT,

30
lang/m2/comp/walk.c
View file

@ -21,12 +21,14 @@ static char *RcsId = "$Header$";
#include "LLlex.h"
#include "node.h"
#include "Lpars.h"
#include "desig.h"
extern arith align();
static int prclev = 0;
extern int proclevel;
static label instructionlabel;
static char return_expr_occurred;
static struct type *func_type;
struct withdesig *WithDesigs;
label
text_label()
@ -54,7 +56,7 @@ WalkModule(module)
vis = CurrVis;
CurrVis = module->mod_vis;
if (!prclev && module->mod_number) {
if (!proclevel && module != Defined) {
/* This module is a local module, but not within a
procedure. Generate code to allocate storage for its
variables. This is done by generating a "bss",
@ -63,6 +65,8 @@ WalkModule(module)
arith size = align(CurrentScope->sc_off, word_align);
if (size == 0) size = word_size;
/* WHY ??? because we generated an INA for it ??? */
C_df_dnam(&(CurrentScope->sc_name[1]));
C_bss_cst(size, (arith) 0, 0);
}
@ -109,7 +113,7 @@ WalkProcedure(procedure)
*/
struct scopelist *vis = CurrVis;
prclev++;
proclevel++;
CurrVis = procedure->prc_vis;
WalkDef(CurrentScope->sc_def);
@ -133,9 +137,9 @@ node_error(procedure->prc_body,"function procedure does not return a value");
C_ret((int) align(func_type->tp_size, word_align));
}
else C_ret(0);
C_end((int) align(-CurrentScope->sc_off, word_align));
C_end(align(-CurrentScope->sc_off, word_align));
CurrVis = vis;
prclev--;
proclevel--;
}
WalkDef(df)
@ -295,6 +299,7 @@ WalkStat(nd, lab)
case WITH:
{
struct scopelist link;
struct withdesig wds;
WalkDesignator(left);
if (left->nd_type->tp_fund != T_RECORD) {
@ -302,12 +307,23 @@ WalkStat(nd, lab)
break;
}
link.sc_scope = left->nd_type->rec_scope;
wds.w_next = WithDesigs;
WithDesigs = &wds;
wds.w_scope = left->nd_type->rec_scope;
/*
Decide here wether to use a temporary variable or
not, depending on the value of Desig.
Suggestion: temporary if Desig != DSG_FIXED
And then:
wds.w_desig = Desig; ???
*/
link.sc_scope = wds.w_scope;
link.next = CurrVis;
CurrVis = &link;
WalkNode(right, lab);
CurrVis = link.next;
/* ??? */
WithDesigs = wds.w_next;
break;
}