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

Some minor mods and a bug fix with type transfer functions

Browse source
This commit is contained in:
ceriel 1987-09-24 13:07:31 +00:00
parent e30234fce8
commit c5674041bf
15 changed files with 107 additions and 95 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -592,7 +592,7 @@ ChkProcCall(expp)
*/
register t_node *left;
t_def *edf = 0;
register struct paramlist *param;
register t_param *param;
int retval = 1;
int cnt = 0;
@ -1264,12 +1264,12 @@ ChkCast(expp)
is no problem as such values take a word on the EM stack
anyway.
*/
register t_node *left = expp->nd_left;
register t_node *arg = expp->nd_right;
register t_type *lefttype = left->nd_type;
register t_type *lefttype = expp->nd_left->nd_type;
t_def *df = expp->nd_left->nd_def;
if ((! arg) || arg->nd_right) {
return df_error(expp, "type cast must have 1 parameter", left->nd_def);
return df_error(expp, "type cast must have 1 parameter", df);
}
if (! ChkExpression(arg->nd_left)) return 0;
@ -1280,11 +1280,17 @@ ChkCast(expp)
if (arg->nd_type->tp_size != lefttype->tp_size &&
(arg->nd_type->tp_size > word_size ||
lefttype->tp_size > word_size)) {
df_error(expp, "unequal sizes in type cast", left->nd_def);
return df_error(expp, "unequal sizes in type cast", df);
}
if (IsConformantArray(arg->nd_type)) {
return df_error(expp,
"type transfer function on conformant array not supported",
df);
}
if (arg->nd_class == Value) {
FreeNode(left);
FreeNode(expp->nd_left);
expp->nd_right->nd_left = 0;
FreeNode(expp->nd_right);
*expp = *arg;

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

@ -359,7 +359,7 @@ CodeCall(nd)
}
CodeParameters(param, arg)
struct paramlist *param;
t_param *param;
t_node *arg;
{
register t_type *tp;

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

@ -31,30 +31,31 @@
int proclevel = 0; /* nesting level of procedures */
int return_occurred; /* set if a return occurs in a block */
#define needs_static_link() (proclevel > 1)
extern t_node *EmptyStatement;
#define needs_static_link() (proclevel > 1)
}
/* inline in declaration: need space
ProcedureDeclaration
{
t_def *df;
} :
{ ++proclevel; }
ProcedureHeading(&df, D_PROCEDURE)
';' block(&(df->prc_body))
IDENT
{ EndProc(df, dot.TOK_IDF);
--proclevel;
}
;
* ProcedureDeclaration
* {
* t_def *df;
* } :
* { ++proclevel; }
* ProcedureHeading(&df, D_PROCEDURE)
* ';' block(&(df->prc_body))
* IDENT
* { EndProc(df, dot.TOK_IDF);
* --proclevel;
* }
* ;
*/
ProcedureHeading(t_def **pdf; int type;)
{
t_type *tp = 0;
arith parmaddr = needs_static_link() ? pointer_size : 0;
struct paramlist *pr = 0;
t_param *pr = 0;
} :
PROCEDURE IDENT
{ *pdf = DeclProc(type, dot.TOK_IDF); }
@ -116,21 +117,21 @@ declaration
;
/* inline in procedureheading: need space
FormalParameters(struct paramlist **ppr; arith *parmaddr; t_type **ptp;):
'('
[
FPSection(ppr, parmaddr)
[
';' FPSection(ppr, parmaddr)
]*
]?
')'
[ ':' qualtype(ptp)
]?
;
* FormalParameters(t_param **ppr; arith *parmaddr; t_type **ptp;):
* '('
* [
* FPSection(ppr, parmaddr)
* [
* ';' FPSection(ppr, parmaddr)
* ]*
* ]?
* ')'
* [ ':' qualtype(ptp)
* ]?
* ;
*/
FPSection(struct paramlist **ppr; arith *parmaddr;)
FPSection(t_param **ppr; arith *parmaddr;)
{
t_node *FPList;
t_type *tp;
@ -267,7 +268,7 @@ ArrayType(t_type **ptp;)
RecordType(t_type **ptp;)
{
register struct scope *scope;
register t_scope *scope;
arith size = 0;
int xalign = struct_align;
}
@ -285,14 +286,14 @@ RecordType(t_type **ptp;)
END
;
FieldListSequence(struct scope *scope; arith *cnt; int *palign;):
FieldListSequence(t_scope *scope; arith *cnt; int *palign;):
FieldList(scope, cnt, palign)
[
';' FieldList(scope, cnt, palign)
]*
;
FieldList(struct scope *scope; arith *cnt; int *palign;)
FieldList(t_scope *scope; arith *cnt; int *palign;)
{
t_node *FldList;
t_type *tp;
@ -358,7 +359,7 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
]?
;
variant(struct scope *scope; arith *cnt; t_type *tp; int *palign;)
variant(t_scope *scope; arith *cnt; t_type *tp; int *palign;)
{
t_node *nd;
} :
@ -442,7 +443,7 @@ ProcedureType(t_type **ptp;) :
FormalTypeList(ptp)
|
{ *ptp = proc_type((t_type *) 0,
(struct paramlist *) 0,
(t_param *) 0,
(arith) 0);
}
]
@ -450,7 +451,7 @@ ProcedureType(t_type **ptp;) :
FormalTypeList(t_type **ptp;)
{
struct paramlist *pr = 0;
t_param *pr = 0;
arith parmaddr = 0;
} :
'('
@ -467,7 +468,7 @@ FormalTypeList(t_type **ptp;)
{ *ptp = proc_type(*ptp, pr, parmaddr); }
;
VarFormalType(struct paramlist **ppr; arith *parmaddr;)
VarFormalType(t_param **ppr; arith *parmaddr;)
{
t_type *tp;
int isvar;

8
lang/m2/comp/def.c
View file

@ -61,7 +61,7 @@ DefInFront(df)
t_def *
MkDef(id, scope, kind)
register t_idf *id;
register struct scope *scope;
register t_scope *scope;
{
/* Create a new definition structure in scope "scope", with
id "id" and kind "kind".
@ -85,7 +85,7 @@ MkDef(id, scope, kind)
t_def *
define(id, scope, kind)
register t_idf *id;
register struct scope *scope;
register t_scope *scope;
int kind;
{
/* Declare an identifier in a scope, but first check if it
@ -228,7 +228,7 @@ DeclProc(type, id)
Also create a name for it.
*/
register t_def *df;
register struct scope *scope;
register t_scope *scope;
extern char *sprint();
static int nmcount;
char buf[256];
@ -312,7 +312,7 @@ DefineLocalModule(id)
a name to be used for code generation.
*/
register t_def *df = define(id, CurrentScope, D_MODULE);
register struct scope *sc;
register t_scope *sc;
static int modulecount = 0;
char buf[256];
extern char *sprint();

4
lang/m2/comp/defmodule.c
View file

@ -91,10 +91,10 @@ GetDefinitionModule(id, incr)
*/
register t_def *df;
static int level;
struct scopelist *vis;
t_scopelist *vis;
char *fn = FileName;
int ln = LineNumber;
struct scope *newsc = CurrentScope;
t_scope *newsc = CurrentScope;
level += incr;
df = lookup(id, GlobalScope, 1);

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

@ -473,7 +473,7 @@ CodeVarDesig(df, ds)
it is a value parameter, it is a var parameter, it is one of
those of an enclosing procedure, or it is global.
*/
register struct scope *sc = df->df_scope;
register t_scope *sc = df->df_scope;
/* Selections from a module are handled earlier, when identifying
the variable, so ...

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

@ -83,7 +83,7 @@ EnterEnumList(Idlist, type)
EnterFieldList(Idlist, type, scope, addr)
t_node *Idlist;
register t_type *type;
struct scope *scope;
t_scope *scope;
arith *addr;
{
/* Put a list of fields in the symbol table.
@ -115,7 +115,7 @@ EnterVarList(Idlist, type, local)
*/
register t_def *df;
register t_node *idlist = Idlist;
register struct scopelist *sc = CurrVis;
register t_scopelist *sc = CurrVis;
char buf[256];
extern char *sprint();
@ -179,7 +179,7 @@ EnterVarList(Idlist, type, local)
}
EnterParamList(ppr, Idlist, type, VARp, off)
struct paramlist **ppr;
t_param **ppr;
t_node *Idlist;
t_type *type;
int VARp;
@ -189,11 +189,11 @@ EnterParamList(ppr, Idlist, type, VARp, off)
"ids" indicates the list of identifiers, "tp" their type, and
"VARp" indicates D_VARPAR or D_VALPAR.
*/
register struct paramlist *pr;
register t_param *pr;
register t_def *df;
register t_node *idlist = Idlist;
t_node *dummy = 0;
static struct paramlist *last;
static t_param *last;
if (! idlist) {
/* Can only happen when a procedure type is defined */
@ -232,7 +232,7 @@ EnterParamList(ppr, Idlist, type, VARp, off)
STATIC
DoImport(df, scope)
register t_def *df;
struct scope *scope;
t_scope *scope;
{
/* Definition "df" is imported to scope "scope".
Handle the case that it is an enumeration type or a module.
@ -266,7 +266,7 @@ DoImport(df, scope)
}
}
STATIC struct scopelist *
STATIC t_scopelist *
ForwModule(df, nd)
register t_def *df;
t_node *nd;
@ -275,7 +275,7 @@ ForwModule(df, nd)
We could also end up here for not found DEFINITION MODULES.
Create a declaration and a scope for this module.
*/
struct scopelist *vis;
t_scopelist *vis;
if (df->df_scope != GlobalScope) {
df->df_scope = enclosing(CurrVis)->sc_scope;
@ -298,7 +298,7 @@ ForwModule(df, nd)
STATIC t_def *
ForwDef(ids, scope)
register t_node *ids;
struct scope *scope;
t_scope *scope;
{
/* Enter a forward definition of "ids" in scope "scope",
if it is not already defined.
@ -396,7 +396,7 @@ EnterFromImportList(Idlist, FromDef, FromId)
/* Import the list Idlist from the module indicated by Fromdef.
*/
register t_node *idlist = Idlist;
register struct scopelist *vis;
register t_scopelist *vis;
register t_def *df;
char *module_name = FromDef->df_idf->id_text;
int forwflag = 0;
@ -462,7 +462,7 @@ EnterImportList(Idlist, local)
This case is indicated by the value 0 of the "local" flag.
*/
register t_node *idlist = Idlist;
struct scope *sc = enclosing(CurrVis)->sc_scope;
t_scope *sc = enclosing(CurrVis)->sc_scope;
extern t_def *GetDefinitionModule();
struct f_info f;

6
lang/m2/comp/lookup.c
View file

@ -26,7 +26,7 @@
t_def *
lookup(id, scope, import)
register t_idf *id;
struct scope *scope;
t_scope *scope;
{
/* Look up a definition of an identifier in scope "scope".
Make the "def" list self-organizing.
@ -65,14 +65,14 @@ lookup(id, scope, import)
t_def *
lookfor(id, vis, give_error)
register t_node *id;
struct scopelist *vis;
t_scopelist *vis;
{
/* Look for an identifier in the visibility range started by "vis".
If it is not defined create a dummy definition and,
if "give_error" is set, give an error message.
*/
register t_def *df;
register struct scopelist *sc = vis;
register t_scopelist *sc = vis;
while (sc) {
df = lookup(id->nd_IDF, sc->sc_scope, 1);

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

@ -23,10 +23,10 @@
#include "def.h"
#include "node.h"
struct scope *PervasiveScope;
struct scopelist *CurrVis, *GlobalVis;
t_scope *PervasiveScope;
t_scopelist *CurrVis, *GlobalVis;
extern int proclevel;
static struct scopelist *PervVis;
static t_scopelist *PervVis;
extern char options[];
/* STATICALLOCDEF "scope" 10 */
@ -37,8 +37,8 @@ open_scope(scopetype)
{
/* Open a scope that is either open (automatic imports) or closed.
*/
register struct scope *sc = new_scope();
register struct scopelist *ls = new_scopelist();
register t_scope *sc = new_scope();
register t_scopelist *ls = new_scopelist();
assert(scopetype == OPENSCOPE || scopetype == CLOSEDSCOPE);
@ -53,10 +53,10 @@ open_scope(scopetype)
CurrVis = ls;
}
struct scope *
t_scope *
open_and_close_scope(scopetype)
{
struct scope *sc;
t_scope *sc;
open_scope(scopetype);
sc = CurrentScope;
@ -66,8 +66,8 @@ open_and_close_scope(scopetype)
InitScope()
{
register struct scope *sc = new_scope();
register struct scopelist *ls = new_scopelist();
register t_scope *sc = new_scope();
register t_scopelist *ls = new_scopelist();
sc->sc_scopeclosed = 0;
sc->sc_def = 0;
@ -161,7 +161,7 @@ df->df_idf->id_text);
Maybe the definitions are in the
enclosing scope?
*/
register struct scopelist *ls =
register t_scopelist *ls =
nextvisible(CurrVis);
t_def *df1 = df->df_nextinscope;
@ -213,7 +213,7 @@ close_scope(flag)
either POINTER declarations, or EXPORTs, or forward references
to MODULES
*/
register struct scope *sc = CurrentScope;
register t_scope *sc = CurrentScope;
assert(sc != 0);

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

@ -38,10 +38,13 @@ struct scopelist {
struct scopelist *sc_encl;
};
extern struct scope
typedef struct scope t_scope;
typedef struct scopelist t_scopelist;
extern t_scope
*PervasiveScope;
extern struct scopelist
extern t_scopelist
*CurrVis, *GlobalVis;
#define CurrentScope (CurrVis->sc_scope)
@ -50,4 +53,4 @@ extern struct scopelist
#define scopeclosed(x) ((x)->sc_scopeclosed)
#define nextvisible(x) ((x)->sc_next) /* use with scopelists */
struct scope *open_and_close_scope();
t_scope *open_and_close_scope();

6
lang/m2/comp/tmpvar.C
View file

@ -39,11 +39,11 @@ struct tmpvar {
static struct tmpvar *TmpInts, /* for integer temporaries */
*TmpPtrs; /* for pointer temporaries */
static struct scope *ProcScope; /* scope of procedure in which the
static t_scope *ProcScope; /* scope of procedure in which the
temporaries are allocated
*/
TmpOpen(sc) struct scope *sc;
TmpOpen(sc) t_scope *sc;
{
/* Initialize for temporaries in scope "sc".
*/
@ -54,7 +54,7 @@ arith
TmpSpace(sz, al)
arith sz;
{
register struct scope *sc = ProcScope;
register t_scope *sc = ProcScope;
sc->sc_off = - WA(align(sz - sc->sc_off, al));
return sc->sc_off;

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

@ -16,6 +16,8 @@ struct paramlist { /* structure for parameterlist of a PROCEDURE */
#define TypeOfParam(xpar) ((xpar)->par_def->df_type)
};
typedef struct paramlist t_param;
/* ALLOCDEF "paramlist" 20 */
struct enume {

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

@ -393,7 +393,7 @@ subr_type(lb, ub)
t_type *
proc_type(result_type, parameters, n_bytes_params)
t_type *result_type;
struct paramlist *parameters;
t_param *parameters;
arith n_bytes_params;
{
register t_type *tp = construct_type(T_PROCEDURE, result_type);
@ -538,7 +538,7 @@ FreeType(tp)
This procedure is only called for types, constructed with
T_PROCEDURE.
*/
register struct paramlist *pr, *pr1;
register t_param *pr, *pr1;
assert(tp->tp_fund == T_PROCEDURE);
@ -713,7 +713,7 @@ DumpType(tp)
break;
case T_PROCEDURE:
{
register struct paramlist *par = ParamList(tp);
register t_param *par = ParamList(tp);
print("PROCEDURE");
if (par) {

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

@ -72,7 +72,7 @@ TstProcEquiv(tp1, tp2)
may also be used for the testing of assignment compatibility
between procedure variables and procedures.
*/
register struct paramlist *p1, *p2;
register t_param *p1, *p2;
/* First check if the result types are equivalent
*/

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

@ -110,8 +110,8 @@ WalkModule(module)
Also generate code for its body.
This code is collected in an initialization routine.
*/
register struct scope *sc;
struct scopelist *savevis = CurrVis;
register t_scope *sc;
t_scopelist *savevis = CurrVis;
CurrVis = module->mod_vis;
priority = module->mod_priority ? module->mod_priority->nd_INT : 0;
@ -176,10 +176,10 @@ WalkProcedure(procedure)
/* Walk through the definition of a procedure and all its
local definitions, checking and generating code.
*/
struct scopelist *savevis = CurrVis;
register struct scope *sc = procedure->prc_vis->sc_scope;
t_scopelist *savevis = CurrVis;
register t_scope *sc = procedure->prc_vis->sc_scope;
register t_type *tp;
register struct paramlist *param;
register t_param *param;
label func_res_label = 0;
arith StackAdjustment = 0;
arith retsav = 0;
@ -575,7 +575,7 @@ WalkStat(nd, exit_label)
case WITH:
{
struct scopelist link;
t_scopelist link;
struct withdesig wds;
t_desig ds;
@ -728,7 +728,7 @@ DoForInit(nd)
}
if (df->df_scope != CurrentScope) {
register struct scopelist *sc = CurrVis;
register t_scopelist *sc = CurrVis;
for (;;) {
if (!sc) {