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

Move to use C structures instead of typedef to align with other ACK compilers and to avoid forward declaration issues with include files.

Browse source
This commit is contained in:
carl 2019-05-11 01:09:03 +08:00
parent 72dcbea3c6
commit e8243402be
42 changed files with 713 additions and 707 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -36,7 +36,7 @@ extern char *getwdir();
t_token dot, t_token dot,
aside; aside;
t_type *toktype; struct type *toktype;
int idfsize = IDFSIZE; int idfsize = IDFSIZE;
int ForeignFlag; int ForeignFlag;
#ifdef DEBUG #ifdef DEBUG
@ -347,7 +347,7 @@ again:
case STIDF: case STIDF:
{ {
register char *tag = &buf[0]; register char *tag = &buf[0];
register t_idf *id; register struct idf *id;
do { do {
if (tag - buf < idfsize) *tag++ = ch; if (tag - buf < idfsize) *tag++ = ch;

10
lang/m2/comp/casestat.xc
View file

@ -42,7 +42,7 @@ struct switch_hdr {
label sh_break; /* label of statement after this one */ label sh_break; /* label of statement after this one */
label sh_default; /* label of ELSE part, or 0 */ label sh_default; /* label of ELSE part, or 0 */
int sh_nrofentries; /* number of cases */ int sh_nrofentries; /* number of cases */
t_type *sh_type; /* type of case expression */ struct type *sh_type; /* type of case expression */
arith sh_lowerbd; /* lowest case label */ arith sh_lowerbd; /* lowest case label */
arith sh_upperbd; /* highest case label */ arith sh_upperbd; /* highest case label */
struct case_entry *sh_entries; /* the cases with their generated struct case_entry *sh_entries; /* the cases with their generated
@ -84,7 +84,7 @@ static int compact(int nr, arith low, arith up)
} }
#define nd_lab nd_symb #define nd_lab nd_symb
static void AddOneCase(struct switch_hdr *sh, t_node *lnode, t_node *rnode, label lbl) static void AddOneCase(struct switch_hdr *sh, struct node *lnode, struct node *rnode, label lbl)
{ {
register struct case_entry *ce = new_case_entry(); register struct case_entry *ce = new_case_entry();
register struct case_entry *c1 = sh->sh_entries, *c2 = 0; register struct case_entry *c1 = sh->sh_entries, *c2 = 0;
@ -201,7 +201,7 @@ node_error(rnode, "multiple case entry for value %ld", (long)(ce->ce_up));
} }
static void AddCases(struct switch_hdr *sh, register t_node *node, label lbl) static void AddCases(struct switch_hdr *sh, register struct node *node, label lbl)
{ {
/* Add case labels to the case label list /* Add case labels to the case label list
*/ */
@ -243,7 +243,7 @@ static void FreeSh(struct switch_hdr *sh)
free_switch_hdr(sh); free_switch_hdr(sh);
} }
int CaseCode(t_node *nd, label exitlabel, int end_reached) int CaseCode(struct node *nd, label exitlabel, int end_reached)
{ {
/* Check the expression, stack a new case header and /* Check the expression, stack a new case header and
fill in the necessary fields. fill in the necessary fields.
@ -251,7 +251,7 @@ int CaseCode(t_node *nd, label exitlabel, int end_reached)
LOOP-statement, or 0. LOOP-statement, or 0.
*/ */
register struct switch_hdr *sh = new_switch_hdr(); register struct switch_hdr *sh = new_switch_hdr();
register t_node *pnode = nd; register struct node *pnode = nd;
register struct case_entry *ce; register struct case_entry *ce;
register arith val; register arith val;
label CaseDescrLab; label CaseDescrLab;

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

@ -26,8 +26,8 @@
#include "Lpars.h" #include "Lpars.h"
#include "idf.h" #include "idf.h"
#include "type.h"
#include "LLlex.h" #include "LLlex.h"
#include "type.h"
#include "def.h" #include "def.h"
#include "node.h" #include "node.h"
#include "scope.h" #include "scope.h"
@ -45,16 +45,16 @@
extern char *symbol2str(); extern char *symbol2str();
/* Forward file declarations */ /* Forward file declarations */
static int ChkStandard(t_node **); static int ChkStandard(struct node **);
static int ChkCast(t_node **); static int ChkCast(struct node **);
static void df_error( static void df_error(
t_node *nd, /* node on which error occurred */ struct node *nd, /* node on which error occurred */
char *mess, /* error message */ char *mess, /* error message */
register t_def *edf) /* do we have a name? */ register struct def *edf) /* do we have a name? */
{ {
if (edf) { if (edf) {
if (edf->df_kind != D_ERROR) { if (edf->df_kind != D_ERROR) {
@ -64,7 +64,7 @@ static void df_error(
else node_error(nd, mess); else node_error(nd, mess);
} }
void MkCoercion(t_node **pnd, register t_type *tp) void MkCoercion(struct node **pnd, register struct type *tp)
{ {
/* Make a coercion from the node indicated by *pnd to the /* Make a coercion from the node indicated by *pnd to the
type indicated by tp. If the node indicated by *pnd type indicated by tp. If the node indicated by *pnd
@ -74,8 +74,8 @@ void MkCoercion(t_node **pnd, register t_type *tp)
- we are in the second pass and the coercion might cause - we are in the second pass and the coercion might cause
an error an error
*/ */
register t_node *nd = *pnd; register struct node *nd = *pnd;
register t_type *nd_tp = nd->nd_type; register struct type *nd_tp = nd->nd_type;
extern int pass_1; extern int pass_1;
char *wmess = 0; char *wmess = 0;
arith op; arith op;
@ -170,12 +170,12 @@ void MkCoercion(t_node **pnd, register t_type *tp)
*pnd = nd; *pnd = nd;
} }
int ChkVariable(register t_node **expp, int flags) int ChkVariable(register struct node **expp, int flags)
{ {
/* Check that "expp" indicates an item that can be /* Check that "expp" indicates an item that can be
assigned to. assigned to.
*/ */
register t_node *exp; register struct node *exp;
if (! ChkDesig(expp, flags)) return 0; if (! ChkDesig(expp, flags)) return 0;
@ -188,13 +188,13 @@ int ChkVariable(register t_node **expp, int flags)
return 1; return 1;
} }
static int ChkArrow(t_node **expp, int flags) static int ChkArrow(struct node **expp, int flags)
{ {
/* Check an application of the '^' operator. /* Check an application of the '^' operator.
The operand must be a variable of a pointer type. The operand must be a variable of a pointer type.
*/ */
register t_type *tp; register struct type *tp;
register t_node *exp = *expp; register struct node *exp = *expp;
assert(exp->nd_class == Arrow); assert(exp->nd_class == Arrow);
assert(exp->nd_symb == '^'); assert(exp->nd_symb == '^');
@ -215,7 +215,7 @@ static int ChkArrow(t_node **expp, int flags)
return 1; return 1;
} }
static int ChkArr(t_node **expp, int flags) static int ChkArr(struct node **expp, int flags)
{ {
/* Check an array selection. /* Check an array selection.
The left hand side must be a variable of an array type, The left hand side must be a variable of an array type,
@ -223,8 +223,8 @@ static int ChkArr(t_node **expp, int flags)
assignment compatible with the array-index. assignment compatible with the array-index.
*/ */
register t_type *tpl; register struct type *tpl;
register t_node *exp = *expp; register struct node *exp = *expp;
assert(exp->nd_class == Arrsel); assert(exp->nd_class == Arrsel);
assert(exp->nd_symb == '[' || exp->nd_symb == ','); assert(exp->nd_symb == '[' || exp->nd_symb == ',');
@ -257,7 +257,7 @@ static int ChkArr(t_node **expp, int flags)
} }
/*ARGSUSED*/ /*ARGSUSED*/
static int ChkValue(t_node **expp, int flags) static int ChkValue(struct node **expp, int flags)
{ {
#ifdef DEBUG #ifdef DEBUG
switch((*expp)->nd_symb) { switch((*expp)->nd_symb) {
@ -273,13 +273,13 @@ static int ChkValue(t_node **expp, int flags)
return 1; return 1;
} }
static int ChkSelOrName(t_node **expp, int flags) static int ChkSelOrName(struct node **expp, int flags)
{ {
/* Check either an ID or a construction of the form /* Check either an ID or a construction of the form
ID.ID [ .ID ]* ID.ID [ .ID ]*
*/ */
register t_def *df; register struct def *df;
register t_node *exp = *expp; register struct node *exp = *expp;
exp->nd_type = error_type; exp->nd_type = error_type;
@ -296,7 +296,7 @@ static int ChkSelOrName(t_node **expp, int flags)
/* A selection from a record or a module. /* A selection from a record or a module.
Modules also have a record type. Modules also have a record type.
*/ */
register t_node *left; register struct node *left;
assert(exp->nd_symb == '.'); assert(exp->nd_symb == '.');
@ -346,13 +346,13 @@ static int ChkSelOrName(t_node **expp, int flags)
return exp->nd_def->df_kind != D_ERROR; return exp->nd_def->df_kind != D_ERROR;
} }
static int ChkExSelOrName(t_node **expp, int flags) static int ChkExSelOrName(struct node **expp, int flags)
{ {
/* Check either an ID or an ID.ID [.ID]* occurring in an /* Check either an ID or an ID.ID [.ID]* occurring in an
expression. expression.
*/ */
register t_def *df; register struct def *df;
register t_node *exp; register struct node *exp;
if (! ChkSelOrName(expp, D_USED)) return 0; if (! ChkSelOrName(expp, D_USED)) return 0;
@ -418,20 +418,20 @@ static int ChkExSelOrName(t_node **expp, int flags)
return 1; return 1;
} }
static int ChkEl(register t_node **expp, t_type *tp) static int ChkEl(register struct node **expp, struct type *tp)
{ {
return ChkExpression(expp) && ChkCompat(expp, tp, "set element"); return ChkExpression(expp) && ChkCompat(expp, tp, "set element");
} }
static int ChkElement(t_node **expp, t_type *tp, arith *set) static int ChkElement(struct node **expp, struct type *tp, arith *set)
{ {
/* Check elements of a set. This routine may call itself /* Check elements of a set. This routine may call itself
recursively. recursively.
Also try to compute the set! Also try to compute the set!
*/ */
register t_node *expr = *expp; register struct node *expr = *expp;
t_type *el_type = ElementType(tp); struct type *el_type = ElementType(tp);
register unsigned int i; register unsigned int i;
arith low, high; arith low, high;
@ -504,15 +504,15 @@ void FreeSet(register arith *s)
} }
} }
static int ChkSet(t_node **expp, int flags) static int ChkSet(struct node **expp, int flags)
{ {
/* Check the legality of a SET aggregate, and try to evaluate it /* Check the legality of a SET aggregate, and try to evaluate it
compile time. Unfortunately this is all rather complicated. compile time. Unfortunately this is all rather complicated.
*/ */
register t_type *tp; register struct type *tp;
register t_node *exp = *expp; register struct node *exp = *expp;
register t_node *nd; register struct node *nd;
register t_def *df; register struct def *df;
int retval = 1; int retval = 1;
int SetIsConstant = 1; int SetIsConstant = 1;
@ -570,9 +570,9 @@ static int ChkSet(t_node **expp, int flags)
return retval; return retval;
} }
static t_node *nextarg(t_node **argp, t_def *edf) static struct node *nextarg(struct node **argp, struct def *edf)
{ {
register t_node *arg = (*argp)->nd_RIGHT; register struct node *arg = (*argp)->nd_RIGHT;
if (! arg) { if (! arg) {
df_error(*argp, "too few arguments supplied", edf); df_error(*argp, "too few arguments supplied", edf);
@ -583,7 +583,7 @@ static t_node *nextarg(t_node **argp, t_def *edf)
return arg; return arg;
} }
static t_node *getarg(t_node **argp, int bases, int designator, t_def *edf) static struct node *getarg(struct node **argp, int bases, int designator, struct def *edf)
{ {
/* This routine is used to fetch the next argument from an /* This routine is used to fetch the next argument from an
argument list. The argument list is indicated by "argp". argument list. The argument list is indicated by "argp".
@ -593,8 +593,8 @@ static t_node *getarg(t_node **argp, int bases, int designator, t_def *edf)
that it must be a designator and may not be a register that it must be a designator and may not be a register
variable. variable.
*/ */
register t_node *arg = nextarg(argp, edf); register struct node *arg = nextarg(argp, edf);
register t_node *left; register struct node *left;
if (! arg || if (! arg ||
! arg->nd_LEFT || ! arg->nd_LEFT ||
@ -608,7 +608,7 @@ static t_node *getarg(t_node **argp, int bases, int designator, t_def *edf)
} }
if (bases) { if (bases) {
t_type *tp = BaseType(left->nd_type); struct type *tp = BaseType(left->nd_type);
if (! designator) MkCoercion(&(arg->nd_LEFT), tp); if (! designator) MkCoercion(&(arg->nd_LEFT), tp);
left = arg->nd_LEFT; left = arg->nd_LEFT;
@ -621,14 +621,14 @@ static t_node *getarg(t_node **argp, int bases, int designator, t_def *edf)
return left; return left;
} }
static t_node *getname(t_node **argp, int kinds, int bases, t_def *edf) static struct node *getname(struct node **argp, int kinds, int bases, struct def *edf)
{ {
/* Get the next argument from argument list "argp". /* Get the next argument from argument list "argp".
The argument must indicate a definition, and the The argument must indicate a definition, and the
definition kind must be one of "kinds". definition kind must be one of "kinds".
*/ */
register t_node *arg = nextarg(argp, edf); register struct node *arg = nextarg(argp, edf);
register t_node *left; register struct node *left;
if (!arg || !arg->nd_LEFT || ! ChkDesig(&(arg->nd_LEFT), D_USED)) return 0; if (!arg || !arg->nd_LEFT || ! ChkDesig(&(arg->nd_LEFT), D_USED)) return 0;
@ -647,14 +647,14 @@ static t_node *getname(t_node **argp, int kinds, int bases, t_def *edf)
return left; return left;
} }
static int ChkProcCall(register t_node *exp) static int ChkProcCall(register struct node *exp)
{ {
/* Check a procedure call /* Check a procedure call
*/ */
register t_node *left; register struct node *left;
t_node *argp; struct node *argp;
t_def *edf = 0; struct def *edf = 0;
register t_param *param; register struct paramlist *param;
int retval = 1; int retval = 1;
int cnt = 0; int cnt = 0;
@ -708,7 +708,7 @@ static int ChkProcCall(register t_node *exp)
return retval; return retval;
} }
static int ChkFunCall(register t_node **expp, int flags) static int ChkFunCall(register struct node **expp, int flags)
{ {
/* Check a call that must have a result /* Check a call that must have a result
*/ */
@ -723,7 +723,7 @@ static int ChkFunCall(register t_node **expp, int flags)
int ChkCall(t_node **expp) int ChkCall(struct node **expp)
{ {
/* Check something that looks like a procedure or function call. /* Check something that looks like a procedure or function call.
Of course this does not have to be a call at all, Of course this does not have to be a call at all,
@ -733,7 +733,7 @@ int ChkCall(t_node **expp)
/* First, get the name of the function or procedure /* First, get the name of the function or procedure
*/ */
if (ChkDesig(&((*expp)->nd_LEFT), D_USED)) { if (ChkDesig(&((*expp)->nd_LEFT), D_USED)) {
register t_node *left = (*expp)->nd_LEFT; register struct node *left = (*expp)->nd_LEFT;
if (IsCast(left)) { if (IsCast(left)) {
/* It was a type cast. /* It was a type cast.
@ -763,7 +763,7 @@ int ChkCall(t_node **expp)
return ChkProcCall(*expp); return ChkProcCall(*expp);
} }
static t_type *ResultOfOperation(int operator, t_type *tp) static struct type *ResultOfOperation(int operator, struct type *tp)
{ {
/* Return the result type of the binary operation "operator", /* Return the result type of the binary operation "operator",
with operand type "tp". with operand type "tp".
@ -820,9 +820,9 @@ static int AllowedTypes(int operator)
} }
static int ChkAddressOper( static int ChkAddressOper(
register t_type *tpl, register struct type *tpl,
register t_type *tpr, register struct type *tpr,
register t_node *expp) register struct node *expp)
{ {
/* Check that either "tpl" or "tpr" are both of type /* Check that either "tpl" or "tpr" are both of type
address_type, or that one of them is, but the other is address_type, or that one of them is, but the other is
@ -833,8 +833,8 @@ static int ChkAddressOper(
if (tpr == address_type && expp->nd_symb == '+') { if (tpr == address_type && expp->nd_symb == '+') {
/* use the fact that '+' is a commutative operator */ /* use the fact that '+' is a commutative operator */
t_type *tmptype = tpr; struct type *tmptype = tpr;
t_node *tmpnode = expp->nd_RIGHT; struct node *tmpnode = expp->nd_RIGHT;
tpr = tpl; tpr = tpl;
expp->nd_RIGHT = expp->nd_LEFT; expp->nd_RIGHT = expp->nd_LEFT;
@ -866,13 +866,13 @@ static int ChkAddressOper(
return 0; return 0;
} }
static int ChkBinOper(t_node **expp, int flags) static int ChkBinOper(struct node **expp, int flags)
{ {
/* Check a binary operation. /* Check a binary operation.
*/ */
register t_node *exp = *expp; register struct node *exp = *expp;
register t_type *tpl, *tpr; register struct type *tpl, *tpr;
t_type *result_type; struct type *result_type;
int allowed; int allowed;
int retval; int retval;
char *symb; char *symb;
@ -981,13 +981,13 @@ static int ChkBinOper(t_node **expp, int flags)
return 1; return 1;
} }
static int ChkUnOper(t_node **expp, int flags) static int ChkUnOper(struct node **expp, int flags)
{ {
/* Check an unary operation. /* Check an unary operation.
*/ */
register t_node *exp = *expp; register struct node *exp = *expp;
register t_node *right = exp->nd_RIGHT; register struct node *right = exp->nd_RIGHT;
register t_type *tpr; register struct type *tpr;
if (exp->nd_symb == COERCION) return 1; if (exp->nd_symb == COERCION) return 1;
if (exp->nd_symb == '(') { if (exp->nd_symb == '(') {
@ -1054,12 +1054,12 @@ static int ChkUnOper(t_node **expp, int flags)
return 0; return 0;
} }
static t_node *getvariable(t_node **argp, t_def *edf, int flags) static struct node *getvariable(struct node **argp, struct def *edf, int flags)
{ {
/* Get the next argument from argument list "argp". /* Get the next argument from argument list "argp".
It must obey the rules of "ChkVariable". It must obey the rules of "ChkVariable".
*/ */
register t_node *arg = nextarg(argp, edf); register struct node *arg = nextarg(argp, edf);
if (! arg || if (! arg ||
! arg->nd_LEFT || ! arg->nd_LEFT ||
@ -1068,14 +1068,14 @@ static t_node *getvariable(t_node **argp, t_def *edf, int flags)
return arg->nd_LEFT; return arg->nd_LEFT;
} }
static int ChkStandard(t_node **expp) static int ChkStandard(struct node **expp)
{ {
/* Check a call of a standard procedure or function /* Check a call of a standard procedure or function
*/ */
register t_node *exp = *expp; register struct node *exp = *expp;
t_node *arglink = exp; struct node *arglink = exp;
register t_node *arg; register struct node *arg;
register t_def *edf = exp->nd_LEFT->nd_def; register struct def *edf = exp->nd_LEFT->nd_def;
int free_it = 0; int free_it = 0;
int isconstant = 0; int isconstant = 0;
@ -1126,8 +1126,8 @@ static int ChkStandard(t_node **expp)
case S_SHORT: case S_SHORT:
case S_LONG: { case S_LONG: {
t_type *tp; struct type *tp;
t_type *s1, *s2, *s3, *d1, *d2, *d3; struct type *s1, *s2, *s3, *d1, *d2, *d3;
if (!(arg = getarg(&arglink, 0, 0, edf))) { if (!(arg = getarg(&arglink, 0, 0, edf))) {
return 0; return 0;
@ -1349,8 +1349,8 @@ static int ChkStandard(t_node **expp)
case S_EXCL: case S_EXCL:
case S_INCL: case S_INCL:
{ {
register t_type *tp; register struct type *tp;
t_node *dummy; struct node *dummy;
exp->nd_type = 0; exp->nd_type = 0;
if (!(arg = getvariable(&arglink, edf, D_USED|D_DEFINED))) return 0; if (!(arg = getvariable(&arglink, edf, D_USED|D_DEFINED))) return 0;
@ -1398,7 +1398,7 @@ static int ChkStandard(t_node **expp)
return 1; return 1;
} }
static int ChkCast(t_node **expp) static int ChkCast(struct node **expp)
{ {
/* Check a cast and perform it if the argument is constant. /* Check a cast and perform it if the argument is constant.
If the sizes don't match, only complain if at least one of them If the sizes don't match, only complain if at least one of them
@ -1407,10 +1407,10 @@ static int ChkCast(t_node **expp)
is no problem as such values take a word on the EM stack is no problem as such values take a word on the EM stack
anyway. anyway.
*/ */
register t_node *exp = *expp; register struct node *exp = *expp;
register t_node *arg = exp->nd_RIGHT; register struct node *arg = exp->nd_RIGHT;
register t_type *lefttype = exp->nd_LEFT->nd_type; register struct type *lefttype = exp->nd_LEFT->nd_type;
t_def *df = exp->nd_LEFT->nd_def; struct def *df = exp->nd_LEFT->nd_def;
if ((! arg) || arg->nd_RIGHT) { if ((! arg) || arg->nd_RIGHT) {
df_error(exp, "type cast must have 1 parameter", df); df_error(exp, "type cast must have 1 parameter", df);
@ -1461,7 +1461,7 @@ static int ChkCast(t_node **expp)
return 1; return 1;
} }
void TryToString(register t_node *nd, t_type *tp) void TryToString(register struct node *nd, struct type *tp)
{ {
/* Try a coercion from character constant to string. /* Try a coercion from character constant to string.
*/ */
@ -1479,20 +1479,20 @@ void TryToString(register t_node *nd, t_type *tp)
} }
} }
static int no_desig(t_node **expp, int flags) static int no_desig(struct node **expp, int flags)
{ {
node_error(*expp, "designator expected"); node_error(*expp, "designator expected");
return 0; return 0;
} }
static int add_flags(t_node **expp, int flags) static int add_flags(struct node **expp, int flags)
{ {
(*expp)->nd_def->df_flags |= flags; (*expp)->nd_def->df_flags |= flags;
return 1; return 1;
} }
int (*ExprChkTable[])(t_node **, int) = { int (*ExprChkTable[])(struct node **, int) = {
ChkValue, ChkValue,
ChkArr, ChkArr,
ChkBinOper, ChkBinOper,
@ -1508,7 +1508,7 @@ int (*ExprChkTable[])(t_node **, int) = {
PNodeCrash, PNodeCrash,
}; };
int (*DesigChkTable[])(t_node **, int) = { int (*DesigChkTable[])(struct node **, int) = {
no_desig, no_desig,
ChkArr, ChkArr,
no_desig, no_desig,

12
lang/m2/comp/chk_expr.h
View file

@ -11,10 +11,10 @@
/* $Id$ */ /* $Id$ */
extern int (*ExprChkTable[])(t_node **, int); /* table of expression checking extern int (*ExprChkTable[])(struct node **, int); /* table of expression checking
functions, indexed by node class functions, indexed by node class
*/ */
extern int (*DesigChkTable[])(t_node **, int); /* table of designator checking extern int (*DesigChkTable[])(struct node **, int); /* table of designator checking
functions, indexed by node class functions, indexed by node class
*/ */
@ -26,10 +26,10 @@ extern int (*DesigChkTable[])(t_node **, int); /* table of designator checking
#define dec_refcount(s) (*((int *)(s) - 1) -= 1) #define dec_refcount(s) (*((int *)(s) - 1) -= 1)
#define refcount(s) (*((int *)(s) - 1)) #define refcount(s) (*((int *)(s) - 1))
void MkCoercion(t_node **pnd, register t_type *tp); void MkCoercion(struct node **pnd, register struct type *tp);
int ChkVariable(register t_node **expp, int flags); int ChkVariable(register struct node **expp, int flags);
int ChkCall(t_node **expp); int ChkCall(struct node **expp);
void TryToString(register t_node *nd, t_type *tp); void TryToString(register struct node *nd, struct type *tp);
/* Generates a set of "size" bytes and increments its reference count. */ /* Generates a set of "size" bytes and increments its reference count. */
arith *MkSet(unsigned int size); arith *MkSet(unsigned int size);

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

@ -38,19 +38,19 @@
extern int proclevel; extern int proclevel;
extern char options[]; extern char options[];
extern t_desig null_desig; extern struct desig null_desig;
int fp_used; int fp_used;
/* Forward declarations */ /* Forward declarations */
static void CodeParameters(t_param *, register t_node *); static void CodeParameters(struct paramlist *, register struct node *);
static void CodeStd(t_node *); static void CodeStd(struct node *);
static void compare(int, label); static void compare(int, label);
static void truthvalue(int); static void truthvalue(int);
static void CodeUoper(register t_node *); static void CodeUoper(register struct node *);
static void CodeSet(register t_node *, int); static void CodeSet(register struct node *, int);
static void CodeEl(register t_node *, register t_type *, int); static void CodeEl(register struct node *, register struct type *, int);
static void CodeDAddress(t_node *, int); static void CodeDAddress(struct node *, int);
static void DoHIGH(register t_def *); static void DoHIGH(register struct def *);
void CodeConst(arith cst, int size) void CodeConst(arith cst, int size)
{ {
@ -65,7 +65,7 @@ void CodeConst(arith cst, int size)
} }
} }
void CodeString(register t_node *nd) void CodeString(register struct node *nd)
{ {
if (nd->nd_type->tp_fund != T_STRING) { if (nd->nd_type->tp_fund != T_STRING) {
/* Character constant */ /* Character constant */
@ -77,9 +77,9 @@ void CodeString(register t_node *nd)
c_lae_dlb(data_label); c_lae_dlb(data_label);
} }
void CodeExpr(t_node *nd, t_desig *ds, label true_label, label false_label) void CodeExpr(struct node *nd, struct desig *ds, label true_label, label false_label)
{ {
register t_type *tp = nd->nd_type; register struct type *tp = nd->nd_type;
DoLineno(nd); DoLineno(nd);
if (tp->tp_fund == T_REAL) fp_used = 1; if (tp->tp_fund == T_REAL) fp_used = 1;
@ -174,7 +174,7 @@ void CodeExpr(t_node *nd, t_desig *ds, label true_label, label false_label)
} }
} }
void CodeCoercion(t_type *t1, t_type *t2) void CodeCoercion(struct type *t1, struct type *t2)
{ {
int fund1, fund2; int fund1, fund2;
int sz1 = t1->tp_size; int sz1 = t1->tp_size;
@ -293,11 +293,11 @@ void CodeCoercion(t_type *t1, t_type *t2)
} }
} }
void CodeCall(t_node *nd) void CodeCall(struct node *nd)
{ {
register t_node *left = nd->nd_LEFT; register struct node *left = nd->nd_LEFT;
t_type *result_tp; struct type *result_tp;
int needs_fn; int needs_fn;
if (left->nd_type == std_type) { if (left->nd_type == std_type) {
@ -320,7 +320,7 @@ void CodeCall(t_node *nd)
switch(left->nd_class) { switch(left->nd_class) {
case Def: { case Def: {
register t_def *df = left->nd_def; register struct def *df = left->nd_def;
if (df->df_kind == D_CONST) { if (df->df_kind == D_CONST) {
/* a procedure address */ /* a procedure address */
@ -358,10 +358,10 @@ void CodeCall(t_node *nd)
} }
/* Generates code to setup the parameters of a procedure call. */ /* Generates code to setup the parameters of a procedure call. */
static void CodeParameters(t_param *param, register t_node *arg) static void CodeParameters(struct paramlist *param, register struct node *arg)
{ {
register t_type *tp; register struct type *tp;
register t_type *arg_type; register struct type *arg_type;
assert(param != 0 && arg != 0); assert(param != 0 && arg != 0);
@ -373,7 +373,7 @@ static void CodeParameters(t_param *param, register t_node *arg)
arg = arg->nd_LEFT; arg = arg->nd_LEFT;
arg_type = arg->nd_type; arg_type = arg->nd_type;
if (IsConformantArray(tp)) { if (IsConformantArray(tp)) {
register t_type *elem = tp->arr_elem; register struct type *elem = tp->arr_elem;
C_loc(tp->arr_elsize); C_loc(tp->arr_elsize);
if (IsConformantArray(arg_type)) { if (IsConformantArray(arg_type)) {
@ -439,7 +439,7 @@ static void CodeParameters(t_param *param, register t_node *arg)
CodePExpr(arg); CodePExpr(arg);
} }
void CodePString(t_node *nd, t_type *tp) void CodePString(struct node *nd, struct type *tp)
{ {
arith szarg = WA(nd->nd_type->tp_size); arith szarg = WA(nd->nd_type->tp_size);
register arith zersz = WA(tp->tp_size) - szarg; register arith zersz = WA(tp->tp_size) - szarg;
@ -471,7 +471,7 @@ static void addu(int sz)
C_adu((arith)sz); C_adu((arith)sz);
} }
static int complex_lhs(register t_node *nd) static int complex_lhs(register struct node *nd)
{ {
switch(nd->nd_class) { switch(nd->nd_class) {
case Value: case Value:
@ -487,11 +487,11 @@ static int complex_lhs(register t_node *nd)
} }
/* Generate code for internal procedures */ /* Generate code for internal procedures */
static void CodeStd(t_node *nd) static void CodeStd(struct node *nd)
{ {
register t_node *arg = nd->nd_RIGHT; register struct node *arg = nd->nd_RIGHT;
register t_node *left = 0; register struct node *left = 0;
register t_type *tp = 0; register struct type *tp = 0;
int std = nd->nd_LEFT->nd_def->df_value.df_stdname; int std = nd->nd_LEFT->nd_def->df_value.df_stdname;
if (arg) { if (arg) {
@ -642,7 +642,7 @@ static void CodeStd(t_node *nd)
} }
} }
static int needs_rangecheck(register t_type *tpl, t_type *tpr) static int needs_rangecheck(register struct type *tpl, struct type *tpr)
{ {
arith rlo, rhi; arith rlo, rhi;
@ -665,7 +665,7 @@ static int needs_rangecheck(register t_type *tpl, t_type *tpr)
return 0; return 0;
} }
void RangeCheck(register t_type *tpl, t_type *tpr) void RangeCheck(register struct type *tpl, struct type *tpr)
{ {
arith rlo, rhi; arith rlo, rhi;
@ -690,7 +690,7 @@ void RangeCheck(register t_type *tpl, t_type *tpr)
} }
} }
void Operands(register t_node *nd) void Operands(register struct node *nd)
{ {
CodePExpr(nd->nd_LEFT); CodePExpr(nd->nd_LEFT);
@ -699,13 +699,13 @@ void Operands(register t_node *nd)
} }
void CodeOper( void CodeOper(
register t_node *expr, /* the expression tree itself */ register struct node *expr, /* the expression tree itself */
label true_label, label true_label,
label false_label /* labels to jump to in logical expr's */ label false_label /* labels to jump to in logical expr's */
) )
{ {
register t_node *leftop = expr->nd_LEFT; register struct node *leftop = expr->nd_LEFT;
register t_node *rightop = expr->nd_RIGHT; register struct node *rightop = expr->nd_RIGHT;
int fund = expr->nd_type->tp_fund; int fund = expr->nd_type->tp_fund;
arith size = expr->nd_type->tp_size; arith size = expr->nd_type->tp_size;
@ -850,7 +850,7 @@ void CodeOper(
case GREATEREQUAL: case GREATEREQUAL:
case '=': case '=':
case '#': { case '#': {
t_type *tp; struct type *tp;
Operands(expr); Operands(expr);
tp = BaseType(leftop->nd_type); tp = BaseType(leftop->nd_type);
@ -913,7 +913,7 @@ void CodeOper(
stack stack
*/ */
label l_toolarge = NO_LABEL, l_cont = NO_LABEL; label l_toolarge = NO_LABEL, l_cont = NO_LABEL;
t_type *ltp = leftop->nd_type; struct type *ltp = leftop->nd_type;
if (leftop->nd_symb == COERCION) { if (leftop->nd_symb == COERCION) {
/* Could be coercion to word_type. */ /* Could be coercion to word_type. */
@ -968,7 +968,7 @@ void CodeOper(
case OR: case OR:
case AND: { case AND: {
label l_maybe = ++text_label, l_end = NO_LABEL; label l_maybe = ++text_label, l_end = NO_LABEL;
t_desig Des; struct desig Des;
Des = null_desig; Des = null_desig;
@ -1056,9 +1056,9 @@ static void truthvalue(int relop)
/* Generates code for an unary expression */ /* Generates code for an unary expression */
void CodeUoper(register t_node *nd) void CodeUoper(register struct node *nd)
{ {
register t_type *tp = nd->nd_type; register struct type *tp = nd->nd_type;
CodePExpr(nd->nd_RIGHT); CodePExpr(nd->nd_RIGHT);
switch(nd->nd_symb) { switch(nd->nd_symb) {
@ -1089,9 +1089,9 @@ void CodeUoper(register t_node *nd)
} }
} }
static void CodeSet(register t_node *nd, int null_set) static void CodeSet(register struct node *nd, int null_set)
{ {
register t_type *tp = nd->nd_type; register struct type *tp = nd->nd_type;
nd = nd->nd_NEXT; nd = nd->nd_NEXT;
while (nd) { while (nd) {
@ -1106,9 +1106,9 @@ static void CodeSet(register t_node *nd, int null_set)
if (null_set) C_zer(tp->tp_size); if (null_set) C_zer(tp->tp_size);
} }
static void CodeEl(register t_node *nd, register t_type *tp, int null_set) static void CodeEl(register struct node *nd, register struct type *tp, int null_set)
{ {
register t_type *eltype = ElementType(tp); register struct type *eltype = ElementType(tp);
if (nd->nd_class == Link && nd->nd_symb == UPTO) { if (nd->nd_class == Link && nd->nd_symb == UPTO) {
if (null_set) C_zer(tp->tp_size); if (null_set) C_zer(tp->tp_size);
@ -1131,23 +1131,23 @@ static void CodeEl(register t_node *nd, register t_type *tp, int null_set)
} }
} }
void CodePExpr(register t_node *nd) void CodePExpr(register struct node *nd)
{ {
t_desig designator; struct desig designator;
designator = null_desig; designator = null_desig;
CodeExpr(nd, &designator, NO_LABEL, NO_LABEL); CodeExpr(nd, &designator, NO_LABEL, NO_LABEL);
CodeValue(&designator, nd->nd_type); CodeValue(&designator, nd->nd_type);
} }
static void CodeDAddress(t_node *nd, int chk_controlvar) static void CodeDAddress(struct node *nd, int chk_controlvar)
{ {
/* Generate code to push the address of the designator "nd" /* Generate code to push the address of the designator "nd"
on the stack. on the stack.
*/ */
t_desig designator; struct desig designator;
int chkptr; int chkptr;
designator = null_desig; designator = null_desig;
@ -1167,11 +1167,11 @@ static void CodeDAddress(t_node *nd, int chk_controlvar)
} }
} }
void CodeDStore(register t_node *nd) void CodeDStore(register struct node *nd)
{ {
t_desig designator; struct desig designator;
designator = null_desig; designator = null_desig;
ChkForFOR(nd); ChkForFOR(nd);
@ -1179,7 +1179,7 @@ void CodeDStore(register t_node *nd)
CodeStore(&designator, nd->nd_type); CodeStore(&designator, nd->nd_type);
} }
static void DoHIGH(register t_def *df) static void DoHIGH(register struct def *df)
{ {
/* Get the high index of a conformant array, indicated by "nd". /* Get the high index of a conformant array, indicated by "nd".
The high index is the second field in the descriptor of The high index is the second field in the descriptor of

25
lang/m2/comp/code.h
View file

@ -13,32 +13,33 @@
#include <em_label.h> #include <em_label.h>
/* Forward declarations. */ /* Forward declarations. */
typedef struct node t_node; struct node;
typedef struct desig t_desig; struct desig;
typedef struct type t_type; struct type;
/* Generate code to push constant "cst" with size "size" bytes. */ /* Generate code to push constant "cst" with size "size" bytes. */
void CodeConst(arith cst, int size); void CodeConst(arith cst, int size);
/* Generate constant character or string. */ /* Generate constant character or string. */
void CodeString(register t_node *nd); void CodeString(register struct node *nd);
/* Generate code for an expression contained in "nd". */ /* Generate code for an expression contained in "nd". */
void CodeExpr(t_node *nd, t_desig *ds, label true_label, label false_label); void CodeExpr(struct node *nd, struct desig *ds, label true_label, label false_label);
/* Generate implicit type conversion code. */ /* Generate implicit type conversion code. */
void CodeCoercion(t_type *t1, t_type *t2); void CodeCoercion(struct type *t1, struct type *t2);
/* Generate code for a procedure call including parameter setup. Checking of parameters /* Generate code for a procedure call including parameter setup. Checking of parameters
and result is already done. */ and result is already done. */
void CodeCall(t_node *nd); void CodeCall(struct node *nd);
void CodePString(t_node *nd, t_type *tp); void CodePString(struct node *nd, struct type *tp);
/* Generate a range check if necessary */ /* Generate a range check if necessary */
void RangeCheck(register t_type *tpl, t_type *tpr); void RangeCheck(register struct type *tpl, struct type *tpr);
void CodeOper(register t_node *expr, label true_label, label false_label); void CodeOper(register struct node *expr, label true_label, label false_label);
/* Generate code to push the value of the expression "nd" /* Generate code to push the value of the expression "nd"
on the stack. */ on the stack. */
void CodePExpr(register t_node *nd); void CodePExpr(register struct node *nd);
/* Generate code to store the expression on the stack into the /* Generate code to store the expression on the stack into the
designator "nd". designator "nd".
*/ */
void CodeDStore(register t_node *nd); void CodeDStore(register struct node *nd);
#ifdef SQUEEZE #ifdef SQUEEZE
void c_bra(label l); void c_bra(label l);

46
lang/m2/comp/cstoper.c
View file

@ -48,21 +48,21 @@ arith min_int[] = { 0L, -128L, -32768L, 0L, -2147483647L-1 };
extern char options[]; extern char options[];
static void CutSize(register t_node *); static void CutSize(register struct node *);
static void overflow(t_node *expp) static void overflow(struct node *expp)
{ {
if (expp->nd_type != address_type) { if (expp->nd_type != address_type) {
node_warning(expp, W_ORDINARY, "overflow in constant expression"); node_warning(expp, W_ORDINARY, "overflow in constant expression");
} }
} }
static void commonbin(t_node **expp) static void commonbin(struct node **expp)
{ {
register t_node *exp = *expp; register struct node *exp = *expp;
t_type *tp = exp->nd_type; struct type *tp = exp->nd_type;
register t_node *right = exp->nd_RIGHT; register struct node *right = exp->nd_RIGHT;
exp->nd_RIGHT = 0; exp->nd_RIGHT = 0;
FreeNode(exp); FreeNode(exp);
@ -70,13 +70,13 @@ static void commonbin(t_node **expp)
right->nd_type = tp; right->nd_type = tp;
} }
void cstunary(t_node **expp) void cstunary(struct node **expp)
{ {
/* The unary operation in "expp" is performed on the constant /* The unary operation in "expp" is performed on the constant
expression below it, and the result stored in expp. expression below it, and the result stored in expp.
*/ */
register t_node *exp = *expp; register struct node *exp = *expp;
register t_node *right = exp->nd_RIGHT; register struct node *right = exp->nd_RIGHT;
register arith o1 = right->nd_INT; register arith o1 = right->nd_INT;
switch(exp->nd_symb) { switch(exp->nd_symb) {
@ -119,13 +119,13 @@ static void divide(arith *pdiv, arith *prem)
*prem = (unsigned arith) o1 % (unsigned arith) o2; *prem = (unsigned arith) o1 % (unsigned arith) o2;
} }
void cstibin(t_node **expp) void cstibin(struct node **expp)
{ {
/* The binary operation in "expp" is performed on the constant /* The binary operation in "expp" is performed on the constant
expressions below it, and the result restored in expp. expressions below it, and the result restored in expp.
This version is for INTEGER expressions. This version is for INTEGER expressions.
*/ */
register t_node *exp = *expp; register struct node *exp = *expp;
register arith o1 = exp->nd_LEFT->nd_INT; register arith o1 = exp->nd_LEFT->nd_INT;
register arith o2 = exp->nd_RIGHT->nd_INT; register arith o2 = exp->nd_RIGHT->nd_INT;
register int sz = exp->nd_type->tp_size; register int sz = exp->nd_type->tp_size;
@ -228,13 +228,13 @@ void cstibin(t_node **expp)
CutSize(*expp); CutSize(*expp);
} }
void cstfbin(t_node **expp) void cstfbin(struct node **expp)
{ {
/* The binary operation in "expp" is performed on the constant /* The binary operation in "expp" is performed on the constant
expressions below it, and the result restored in expp. expressions below it, and the result restored in expp.
This version is for REAL expressions. This version is for REAL expressions.
*/ */
register t_node *exp = *expp; register struct node *exp = *expp;
register struct real *p = exp->nd_LEFT->nd_REAL; register struct real *p = exp->nd_LEFT->nd_REAL;
register flt_arith *o1 = &p->r_val; register flt_arith *o1 = &p->r_val;
register flt_arith *o2 = &exp->nd_RIGHT->nd_RVAL; register flt_arith *o2 = &exp->nd_RIGHT->nd_RVAL;
@ -288,7 +288,7 @@ void cstfbin(t_node **expp)
switch(flt_status) { switch(flt_status) {
case FLT_OVFL: case FLT_OVFL:
node_warning(exp, "floating point overflow on %s", node_warning(exp, W_ORDINARY, "floating point overflow on %s",
symbol2str(exp->nd_symb)); symbol2str(exp->nd_symb));
break; break;
case FLT_DIV0: case FLT_DIV0:
@ -315,13 +315,13 @@ void cstfbin(t_node **expp)
CutSize(exp); CutSize(exp);
} }
void cstubin(t_node **expp) void cstubin(struct node **expp)
{ {
/* The binary operation in "expp" is performed on the constant /* The binary operation in "expp" is performed on the constant
expressions below it, and the result restored in expressions below it, and the result restored in
expp. expp.
*/ */
register t_node *exp = *expp; register struct node *exp = *expp;
arith o1 = exp->nd_LEFT->nd_INT; arith o1 = exp->nd_LEFT->nd_INT;
arith o2 = exp->nd_RIGHT->nd_INT; arith o2 = exp->nd_RIGHT->nd_INT;
register int sz = exp->nd_type->tp_size; register int sz = exp->nd_type->tp_size;
@ -420,10 +420,10 @@ void cstubin(t_node **expp)
CutSize(exp); CutSize(exp);
} }
void cstset(t_node **expp) void cstset(struct node **expp)
{ {
extern arith *MkSet(); extern arith *MkSet();
register t_node *exp = *expp; register struct node *exp = *expp;
register arith *set1, *set2, *set3; register arith *set1, *set2, *set3;
register unsigned int setsize; register unsigned int setsize;
register int j; register int j;
@ -535,13 +535,13 @@ void cstset(t_node **expp)
FreeNode(exp); FreeNode(exp);
} }
void cstcall(t_node **expp, int call) void cstcall(struct node **expp, int call)
{ {
/* a standard procedure call is found that can be evaluated /* a standard procedure call is found that can be evaluated
compile time, so do so. compile time, so do so.
*/ */
register t_node *expr; register struct node *expr;
register t_type *tp; register struct type *tp;
assert((*expp)->nd_class == Call); assert((*expp)->nd_class == Call);
expr = (*expp)->nd_RIGHT->nd_LEFT; expr = (*expp)->nd_RIGHT->nd_LEFT;
@ -609,12 +609,12 @@ void cstcall(t_node **expp, int call)
} }
} }
static void CutSize(register t_node *expr) static void CutSize(register struct node *expr)
{ {
/* The constant value of the expression expr is made to /* The constant value of the expression expr is made to
conform to the size of the type of the expression. conform to the size of the type of the expression.
*/ */
register t_type *tp = BaseType(expr->nd_type); register struct type *tp = BaseType(expr->nd_type);
assert(expr->nd_class == Value); assert(expr->nd_class == Value);
if (tp->tp_fund == T_REAL) return; if (tp->tp_fund == T_REAL) return;

12
lang/m2/comp/cstoper.h
View file

@ -11,18 +11,18 @@
/* Compile time constant evaluations */ /* Compile time constant evaluations */
void cstunary(t_node **expp); void cstunary(struct node **expp);
void cstibin(t_node **expp); void cstibin(struct node **expp);
void cstfbin(t_node **expp); void cstfbin(struct node **expp);
void cstubin(t_node **expp); void cstubin(struct node **expp);
/** Evaluates the constant set operators at compile time /** Evaluates the constant set operators at compile time
* and returns the result in "expp". * and returns the result in "expp".
*/ */
void cstset(t_node **expp); void cstset(struct node **expp);
/* Evaluates the result of internal procedures on constants /* Evaluates the result of internal procedures on constants
* at compile time, and returns the result in "expp". * at compile time, and returns the result in "expp".
*/ */
void cstcall(t_node **expp, int call); void cstcall(struct node **expp, int call);
/* Compile time constant evaluator system initialization. */ /* Compile time constant evaluator system initialization. */
void InitCst(void); void InitCst(void);

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

@ -35,7 +35,7 @@
int proclevel = 0; /* nesting level of procedures */ int proclevel = 0; /* nesting level of procedures */
int return_occurred; /* set if a return occurs in a block */ int return_occurred; /* set if a return occurs in a block */
extern t_node *EmptyStatement; extern struct node *EmptyStatement;
#define needs_static_link() (proclevel > 1) #define needs_static_link() (proclevel > 1)
} }
@ -43,7 +43,7 @@ extern t_node *EmptyStatement;
/* inline in declaration: need space /* inline in declaration: need space
* ProcedureDeclaration * ProcedureDeclaration
* { * {
* t_def *df; * struct def *df;
* } : * } :
* { ++proclevel; } * { ++proclevel; }
* ProcedureHeading(&df, D_PROCEDURE) * ProcedureHeading(&df, D_PROCEDURE)
@ -55,11 +55,11 @@ extern t_node *EmptyStatement;
* ; * ;
*/ */
ProcedureHeading(t_def **pdf; int type;) ProcedureHeading(struct def **pdf; int type;)
{ {
t_type *tp = 0; struct type *tp = 0;
arith parmaddr = needs_static_link() ? pointer_size : 0; arith parmaddr = needs_static_link() ? pointer_size : 0;
t_param *pr = 0; struct paramlist *pr = 0;
} : } :
PROCEDURE IDENT PROCEDURE IDENT
{ *pdf = DeclProc(type, dot.TOK_IDF); } { *pdf = DeclProc(type, dot.TOK_IDF); }
@ -88,7 +88,7 @@ warning(W_STRICT, "procedure \"%s\" has a constructed result type",
} }
; ;
block(t_node **pnd;) : block(struct node **pnd;) :
[ %persistent [ %persistent
declaration declaration
]* ]*
@ -104,7 +104,7 @@ block(t_node **pnd;) :
declaration declaration
{ {
t_def *df; struct def *df;
} : } :
CONST [ ConstantDeclaration ';' ]* CONST [ ConstantDeclaration ';' ]*
| |
@ -129,7 +129,7 @@ declaration
; ;
/* inline in procedureheading: need space /* inline in procedureheading: need space
* FormalParameters(t_param **ppr; arith *parmaddr; t_type **ptp;): * FormalParameters(struct paramlist **ppr; arith *parmaddr; struct type **ptp;):
* '(' * '('
* [ * [
* FPSection(ppr, parmaddr) * FPSection(ppr, parmaddr)
@ -145,21 +145,21 @@ declaration
* ; * ;
*/ */
FPSection(t_param **ppr; arith *parmaddr;) FPSection(struct paramlist **ppr; arith *parmaddr;)
{ {
t_node *FPList; struct node *FPList;
t_type *tp; struct type *tp;
int VARp; int VARp;
} : } :
var(&VARp) IdentList(&FPList) ':' FormalType(&tp) var(&VARp) IdentList(&FPList) ':' FormalType(&tp)
{ EnterParamList(ppr, FPList, tp, VARp, parmaddr); } { EnterParamList(ppr, FPList, tp, VARp, parmaddr); }
; ;
FormalType(t_type **ptp;) FormalType(struct type **ptp;)
/* index type of conformant array is "CARDINAL". /* index type of conformant array is "CARDINAL".
Recognize a conformant array by size 0. Recognize a conformant array by size 0.
*/ */
{ register t_type *tp; { register struct type *tp;
} : } :
ARRAY OF ARRAY OF
{ tp = construct_type(T_ARRAY, card_type); } { tp = construct_type(T_ARRAY, card_type); }
@ -173,9 +173,9 @@ FormalType(t_type **ptp;)
TypeDeclaration TypeDeclaration
{ {
t_def *df; struct def *df;
t_type *tp; struct type *tp;
register t_node *nd; register struct node *nd;
}: }:
IDENT { df = define(dot.TOK_IDF, CurrentScope, D_TYPE); IDENT { df = define(dot.TOK_IDF, CurrentScope, D_TYPE);
nd = dot2leaf(Name); nd = dot2leaf(Name);
@ -186,7 +186,7 @@ TypeDeclaration
} }
; ;
type(register t_type **ptp;): type(register struct type **ptp;):
%default SimpleType(ptp) %default SimpleType(ptp)
| |
ArrayType(ptp) ArrayType(ptp)
@ -200,7 +200,7 @@ type(register t_type **ptp;):
ProcedureType(ptp) ProcedureType(ptp)
; ;
SimpleType(register t_type **ptp;) : SimpleType(register struct type **ptp;) :
qualtype(ptp) qualtype(ptp)
[ [
/* nothing */ /* nothing */
@ -216,17 +216,17 @@ SimpleType(register t_type **ptp;) :
SubrangeType(ptp) SubrangeType(ptp)
; ;
enumeration(t_type **ptp;) enumeration(struct type **ptp;)
{ {
t_node *EnumList; struct node *EnumList;
} : } :
'(' IdentList(&EnumList) ')' '(' IdentList(&EnumList) ')'
{ *ptp = enum_type(EnumList); } { *ptp = enum_type(EnumList); }
; ;
IdentList(t_node **p;) IdentList(struct node **p;)
{ {
register t_node *q; register struct node *q;
} : } :
IDENT { *p = q = dot2leaf(Select); } IDENT { *p = q = dot2leaf(Select); }
[ %persistent [ %persistent
@ -237,9 +237,9 @@ IdentList(t_node **p;)
]* ]*
; ;
SubrangeType(t_type **ptp;) SubrangeType(struct type **ptp;)
{ {
t_node *nd1, *nd2; struct node *nd1, *nd2;
}: }:
/* /*
This is not exactly the rule in the new report, but see This is not exactly the rule in the new report, but see
@ -254,10 +254,10 @@ SubrangeType(t_type **ptp;)
} }
; ;
ArrayType(t_type **ptp;) ArrayType(struct type **ptp;)
{ {
t_type *tp; struct type *tp;
register t_type *tp1, *tp2; register struct type *tp1, *tp2;
} : } :
ARRAY SimpleType(&tp) ARRAY SimpleType(&tp)
{ tp1 = tp2 = construct_type(T_ARRAY, tp); } { tp1 = tp2 = construct_type(T_ARRAY, tp); }
@ -273,9 +273,9 @@ ArrayType(t_type **ptp;)
} }
; ;
RecordType(t_type **ptp;) RecordType(struct type **ptp;)
{ {
register t_scope *scope; register struct scope *scope;
arith size = 0; arith size = 0;
int xalign = struct_align; int xalign = struct_align;
} }
@ -294,19 +294,19 @@ RecordType(t_type **ptp;)
END END
; ;
FieldListSequence(t_scope *scope; arith *cnt; int *palign;): FieldListSequence(struct scope *scope; arith *cnt; int *palign;):
FieldList(scope, cnt, palign) FieldList(scope, cnt, palign)
[ [
';' FieldList(scope, cnt, palign) ';' FieldList(scope, cnt, palign)
]* ]*
; ;
FieldList(t_scope *scope; arith *cnt; int *palign;) FieldList(struct scope *scope; arith *cnt; int *palign;)
{ {
t_node *FldList; struct node *FldList;
t_type *tp; struct type *tp;
t_node *nd; struct node *nd;
register t_def *df; register struct def *df;
arith tcnt, max; arith tcnt, max;
} : } :
[ [
@ -374,9 +374,9 @@ FieldList(t_scope *scope; arith *cnt; int *palign;)
] ]
; ;
variant(t_scope *scope; arith *cnt; t_type *tp; int *palign;) variant(struct scope *scope; arith *cnt; struct type *tp; int *palign;)
{ {
t_node *nd; struct node *nd;
} : } :
[ [
CaseLabelList(&tp, &nd) CaseLabelList(&tp, &nd)
@ -392,7 +392,7 @@ variant(t_scope *scope; arith *cnt; t_type *tp; int *palign;)
/* Changed rule in new modula-2 */ /* Changed rule in new modula-2 */
; ;
CaseLabelList(t_type **ptp; t_node **pnd;): CaseLabelList(struct type **ptp; struct node **pnd;):
CaseLabels(ptp, pnd) CaseLabels(ptp, pnd)
[ [
{ *pnd = dot2node(Link, *pnd, NULLNODE); } { *pnd = dot2node(Link, *pnd, NULLNODE); }
@ -401,14 +401,14 @@ CaseLabelList(t_type **ptp; t_node **pnd;):
]* ]*
; ;
CaseLabels(t_type **ptp; register t_node **pnd;) CaseLabels(struct type **ptp; register struct node **pnd;)
{ {
register t_node *nd; register struct node *nd;
}: }:
ConstExpression(pnd) ConstExpression(pnd)
{ {
if (*ptp != 0) { if (*ptp != 0) {
t_type *tp = intorcard(*ptp, struct type *tp = intorcard(*ptp,
BaseType((*pnd)->nd_type)); BaseType((*pnd)->nd_type));
if (tp) *ptp = tp; if (tp) *ptp = tp;
ChkCompat(pnd, *ptp, "case label"); ChkCompat(pnd, *ptp, "case label");
@ -444,8 +444,8 @@ CaseLabels(t_type **ptp; register t_node **pnd;)
} }
; ;
SetType(t_type **ptp;) SetType(struct type **ptp;)
{ t_type *tp; { struct type *tp;
} : } :
SET OF SimpleType(&tp) SET OF SimpleType(&tp)
{ *ptp = set_type(tp); } { *ptp = set_type(tp); }
@ -455,8 +455,8 @@ SetType(t_type **ptp;)
have to be declared yet, so be careful about identifying have to be declared yet, so be careful about identifying
type-identifiers. type-identifiers.
*/ */
PointerType(register t_type **ptp;) PointerType(register struct type **ptp;)
{ register t_type *tp; { register struct type *tp;
} : } :
{ tp = construct_type(T_POINTER, NULLTYPE); } { tp = construct_type(T_POINTER, NULLTYPE); }
POINTER TO POINTER TO
@ -468,19 +468,19 @@ PointerType(register t_type **ptp;)
{ *ptp = tp; } { *ptp = tp; }
; ;
qualtype(t_type **ptp;) qualtype(struct type **ptp;)
{ {
t_node *nd; struct node *nd;
} : } :
qualident(&nd) qualident(&nd)
{ *ptp = qualified_type(&nd); } { *ptp = qualified_type(&nd); }
; ;
ProcedureType(t_type **ptp;) ProcedureType(struct type **ptp;)
{ {
t_param *pr = 0; struct paramlist *pr = 0;
arith parmaddr = 0; arith parmaddr = 0;
t_type *tp = 0; struct type *tp = 0;
} : } :
PROCEDURE PROCEDURE
[ [
@ -490,7 +490,7 @@ ProcedureType(t_type **ptp;)
{ *ptp = proc_type(tp, pr, parmaddr); } { *ptp = proc_type(tp, pr, parmaddr); }
; ;
FormalTypeList(t_param **ppr; arith *pparmaddr; t_type **ptp;) : FormalTypeList(struct paramlist **ppr; arith *pparmaddr; struct type **ptp;) :
'(' '('
[ [
VarFormalType(ppr, pparmaddr) VarFormalType(ppr, pparmaddr)
@ -505,9 +505,9 @@ FormalTypeList(t_param **ppr; arith *pparmaddr; t_type **ptp;) :
] ]
; ;
VarFormalType(t_param **ppr; arith *pparmaddr;) VarFormalType(struct paramlist **ppr; arith *pparmaddr;)
{ {
t_type *tp; struct type *tp;
int isvar; int isvar;
} : } :
var(&isvar) var(&isvar)
@ -525,9 +525,9 @@ var(int *VARp;) :
ConstantDeclaration ConstantDeclaration
{ {
t_idf *id; struct idf *id;
t_node *nd; struct node *nd;
register t_def *df; register struct def *df;
}: }:
IDENT { id = dot.TOK_IDF; } IDENT { id = dot.TOK_IDF; }
'=' ConstExpression(&nd) '=' ConstExpression(&nd)
@ -540,9 +540,9 @@ ConstantDeclaration
VariableDeclaration VariableDeclaration
{ {
t_node *VarList; struct node *VarList;
register t_node *nd; register struct node *nd;
t_type *tp; struct type *tp;
} : } :
IdentAddr(&VarList) IdentAddr(&VarList)
{ nd = VarList; } { nd = VarList; }
@ -554,9 +554,9 @@ VariableDeclaration
{ EnterVarList(VarList, tp, proclevel > 0); } { EnterVarList(VarList, tp, proclevel > 0); }
; ;
IdentAddr(t_node **pnd;) IdentAddr(struct node **pnd;)
{ {
register t_node *nd; register struct node *nd;
} : } :
IDENT { nd = dot2leaf(Name); IDENT { nd = dot2leaf(Name);
*pnd = dot2node(Link, nd, NULLNODE); *pnd = dot2node(Link, nd, NULLNODE);

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

@ -48,14 +48,14 @@ static void internal(register char *c)
C_inp(c); C_inp(c);
} }
static void DefInFront(register t_def *df) static void DefInFront(register struct def *df)
{ {
/* Put definition "df" in front of the list of definitions /* Put definition "df" in front of the list of definitions
in its scope. in its scope.
This is neccessary because in some cases the order in this This is neccessary because in some cases the order in this
list is important. list is important.
*/ */
register t_def *df1 = df->df_scope->sc_def; register struct def *df1 = df->df_scope->sc_def;
if (df1 != df) if (df1 != df)
{ {
@ -82,12 +82,12 @@ static void DefInFront(register t_def *df)
} }
} }
t_def *MkDef(register t_idf *id, register t_scope *scope, int kind) struct def *MkDef(register struct idf *id, register struct scope *scope, int kind)
{ {
/* Create a new definition structure in scope "scope", with /* Create a new definition structure in scope "scope", with
id "id" and kind "kind". id "id" and kind "kind".
*/ */
register t_def *df; register struct def *df;
df = new_def(); df = new_def();
df->df_idf = id; df->df_idf = id;
@ -109,14 +109,14 @@ t_def *MkDef(register t_idf *id, register t_scope *scope, int kind)
return df; return df;
} }
t_def *define(register t_idf *id, register t_scope *scope, int kind) struct def *define(register struct idf *id, register struct scope *scope, int kind)
{ {
/* Declare an identifier in a scope, but first check if it /* Declare an identifier in a scope, but first check if it
already has been defined. already has been defined.
If so, then check for the cases in which this is legal, If so, then check for the cases in which this is legal,
and otherwise give an error message. and otherwise give an error message.
*/ */
register t_def *df; register struct def *df;
DO_DEBUG(options['S'], print("define %s, %x\n", id->id_text, kind)); DO_DEBUG(options['S'], print("define %s, %x\n", id->id_text, kind));
df = lookup(id, scope, D_IMPORT, 0); df = lookup(id, scope, D_IMPORT, 0);
@ -211,14 +211,14 @@ t_def *define(register t_idf *id, register t_scope *scope, int kind)
return MkDef(id, scope, kind); return MkDef(id, scope, kind);
} }
void end_definition_list(register t_def **pdf) void end_definition_list(register struct def **pdf)
{ {
/* Remove all imports from a definition module. This is /* Remove all imports from a definition module. This is
neccesary because the implementation module might import neccesary because the implementation module might import
them again. them again.
Also, mark all other definitions "QUALIFIED EXPORT". Also, mark all other definitions "QUALIFIED EXPORT".
*/ */
register t_def *df; register struct def *df;
while ( (df = *pdf) ) while ( (df = *pdf) )
{ {
@ -241,12 +241,12 @@ void end_definition_list(register t_def **pdf)
} }
} }
void RemoveFromIdList(register t_def *df) void RemoveFromIdList(register struct def *df)
{ {
/* Remove definition "df" from the definition list /* Remove definition "df" from the definition list
*/ */
register t_idf *id = df->df_idf; register struct idf *id = df->df_idf;
register t_def *df1; register struct def *df1;
if ((df1 = id->id_def) == df) if ((df1 = id->id_def) == df)
id->id_def = df->df_next; id->id_def = df->df_next;
@ -261,14 +261,14 @@ void RemoveFromIdList(register t_def *df)
} }
} }
t_def * DeclProc(int type, register t_idf *id) struct def * DeclProc(int type, register struct idf *id)
{ {
/* A procedure is declared, either in a definition or a program /* A procedure is declared, either in a definition or a program
module. Create a def structure for it (if neccessary). module. Create a def structure for it (if neccessary).
Also create a name for it. Also create a name for it.
*/ */
register t_def *df; register struct def *df;
register t_scope *scope; register struct scope *scope;
static int nmcount; static int nmcount;
char buf[256]; char buf[256];
@ -326,7 +326,7 @@ t_def * DeclProc(int type, register t_idf *id)
return df; return df;
} }
void EndProc(register t_def *df, t_idf *id) void EndProc(register struct def *df, struct idf *id)
{ {
/* The end of a procedure declaration. /* The end of a procedure declaration.
Check that the closing identifier matches the name of the Check that the closing identifier matches the name of the
@ -344,13 +344,13 @@ void EndProc(register t_def *df, t_idf *id)
} }
} }
t_def * DefineLocalModule(t_idf *id) struct def * DefineLocalModule(struct idf *id)
{ {
/* Create a definition for a local module. Also give it /* Create a definition for a local module. Also give it
a name to be used for code generation. a name to be used for code generation.
*/ */
register t_def *df = define(id, CurrentScope, D_MODULE); register struct def *df = define(id, CurrentScope, D_MODULE);
register t_scope *sc; register struct scope *sc;
static int modulecount = 0; static int modulecount = 0;
char buf[256]; char buf[256];
extern int proclevel; extern int proclevel;
@ -385,7 +385,7 @@ t_def * DefineLocalModule(t_idf *id)
return df; return df;
} }
void CheckWithDef(register t_def *df, t_type *tp) void CheckWithDef(register struct def *df, struct type *tp)
{ {
/* Check the header of a procedure declaration against a /* Check the header of a procedure declaration against a
possible earlier definition in the definition module. possible earlier definition in the definition module.
@ -409,7 +409,7 @@ void CheckWithDef(register t_def *df, t_type *tp)
} }
#ifdef DEBUG #ifdef DEBUG
void PrDef(register t_def *df) void PrDef(register struct def *df)
{ {
print("n: %s, k: %d\n", df->df_idf->id_text, df->df_kind); print("n: %s, k: %d\n", df->df_idf->id_text, df->df_kind);
} }

26
lang/m2/comp/def.xh
View file

@ -131,23 +131,23 @@ struct def { /* list of definitions for a name */
} df_value; } df_value;
}; };
typedef struct def t_def;
/* ALLOCDEF "def" 50 */ /* ALLOCDEF "def" 50 */
#define NULLDEF ((t_def *) 0) #define NULLDEF ((struct def *) 0)
typedef struct scope t_scope; struct scope;
typedef struct idf t_idf; struct idf;
typedef struct type t_type;
t_def *MkDef(register t_idf *id, register t_scope *scope, int kind);
t_def *define(register t_idf *id, register t_scope *scope, int kind); struct def *MkDef(register struct idf *id, register struct scope *scope, int kind);
void RemoveFromIdList(register t_def *df); struct def *define(register struct idf *id, register struct scope *scope, int kind);
t_def * DeclProc(int type, register t_idf *id); void RemoveFromIdList(register struct def *df);
void EndProc(register t_def *df, t_idf *id); struct def * DeclProc(int type, register struct idf *id);
t_def * DefineLocalModule(t_idf *id); void EndProc(register struct def *df, struct idf *id);
void CheckWithDef(register t_def *df, t_type *tp); struct def * DefineLocalModule(struct idf *id);
void end_definition_list(register t_def **pdf); void CheckWithDef(register struct def *df, struct type *tp);
void end_definition_list(register struct def **pdf);
#endif /* DEF_H_ */ #endif /* DEF_H_ */

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

@ -41,7 +41,7 @@ size_t sys_filesize();
extern void DefModule(void); /* Lpars */ extern void DefModule(void); /* Lpars */
t_idf* DefId; struct idf* DefId;
char* getwdir(register char *fn) char* getwdir(register char *fn)
{ {
@ -90,19 +90,19 @@ static int GetFile(char *name)
return 1; return 1;
} }
t_def* GetDefinitionModule(register t_idf* id, int incr) struct def* GetDefinitionModule(register struct idf* id, int incr)
{ {
/* Return a pointer to the "def" structure of the definition /* Return a pointer to the "def" structure of the definition
module indicated by "id". module indicated by "id".
We may have to read the definition module itself. We may have to read the definition module itself.
Also increment level by "incr". Also increment level by "incr".
*/ */
register t_def* df; register struct def* df;
static int level; static int level;
t_scopelist* vis; struct scopelist* vis;
char* fn = FileName; char* fn = FileName;
int ln = LineNumber; int ln = LineNumber;
t_scope* newsc; struct scope* newsc;
level += incr; level += incr;
df = lookup(id, GlobalScope, D_IMPORTED, 0); df = lookup(id, GlobalScope, D_IMPORTED, 0);
@ -139,9 +139,9 @@ t_def* GetDefinitionModule(register t_idf* id, int incr)
remember its name because we have remember its name because we have
to call its initialization routine to call its initialization routine
*/ */
static t_node* nd_end; static struct node* nd_end;
register t_node* n; register struct node* n;
extern t_node* Modules; extern struct node* Modules;
n = dot2leaf(Def); n = dot2leaf(Def);
n->nd_def = newsc->sc_definedby; n->nd_def = newsc->sc_definedby;

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

@ -40,7 +40,7 @@
extern int proclevel; extern int proclevel;
extern char options[]; extern char options[];
static int WordOrDouble(t_desig *ds, arith size) static int WordOrDouble(struct desig *ds, arith size)
{ {
/* Check if designator is suitable for word or double-word /* Check if designator is suitable for word or double-word
operation operation
@ -80,7 +80,7 @@ void STL(arith offset, arith size)
} }
} }
int DoLoad(register t_desig *ds, arith size) int DoLoad(register struct desig *ds, arith size)
{ {
/* Try to load designator with word or double-word operation. /* Try to load designator with word or double-word operation.
Return 0 if not done Return 0 if not done
@ -104,7 +104,7 @@ int DoLoad(register t_desig *ds, arith size)
return 1; return 1;
} }
int DoStore(register t_desig *ds, arith size) int DoStore(register struct desig *ds, arith size)
{ {
/* Try to store designator with word or double-word operation. /* Try to store designator with word or double-word operation.
Return 0 if not done Return 0 if not done
@ -152,7 +152,7 @@ int DoStore(register t_desig *ds, arith size)
multiple of word_size only multiple of word_size only
*/ */
static int suitable_move(register t_type *tp) static int suitable_move(register struct type *tp)
{ {
/* Find out how to load or store the value indicated by "ds". /* Find out how to load or store the value indicated by "ds".
There are four ways: There are four ways:
@ -170,7 +170,7 @@ static int suitable_move(register t_type *tp)
return USE_BLM; return USE_BLM;
} }
void CodeValue(register t_desig *ds, register t_type *tp) void CodeValue(register struct desig *ds, register struct type *tp)
{ {
/* Generate code to load the value of the designator described /* Generate code to load the value of the designator described
in "ds". in "ds".
@ -233,12 +233,12 @@ void CodeValue(register t_desig *ds, register t_type *tp)
ds->dsg_kind = DSG_LOADED; ds->dsg_kind = DSG_LOADED;
} }
void ChkForFOR(register t_node *nd) void ChkForFOR(register struct node *nd)
{ {
/* Check for an assignment to a FOR-loop control variable /* Check for an assignment to a FOR-loop control variable
*/ */
if (nd->nd_class == Def) { if (nd->nd_class == Def) {
register t_def *df = nd->nd_def; register struct def *df = nd->nd_def;
if (df->df_flags & D_FORLOOP) { if (df->df_flags & D_FORLOOP) {
node_warning(nd, node_warning(nd,
@ -250,7 +250,7 @@ void ChkForFOR(register t_node *nd)
} }
} }
void CodeStore(register t_desig *ds, register t_type *tp) void CodeStore(register struct desig *ds, register struct type *tp)
{ {
/* Generate code to store the value on the stack in the designator /* Generate code to store the value on the stack in the designator
described in "ds" described in "ds"
@ -295,12 +295,12 @@ void CodeStore(register t_desig *ds, register t_type *tp)
ds->dsg_kind = DSG_INIT; ds->dsg_kind = DSG_INIT;
} }
void CodeCopy(register t_desig *lhs, register t_desig *rhs, arith sz, arith *psize) void CodeCopy(register struct desig *lhs, register struct desig *rhs, arith sz, arith *psize)
{ {
/* Do part of a copy, which is assumed to be "reasonable", /* Do part of a copy, which is assumed to be "reasonable",
so that it can be done with LOI/STI or BLM. so that it can be done with LOI/STI or BLM.
*/ */
t_desig l, r; struct desig l, r;
l = *lhs; r = *rhs; l = *lhs; r = *rhs;
*psize -= sz; *psize -= sz;
@ -318,17 +318,17 @@ void CodeCopy(register t_desig *lhs, register t_desig *rhs, arith sz, arith *psi
} }
} }
t_desig null_desig; struct desig null_desig;
void CodeMove(register t_desig *rhs, register t_node *left, t_type *rtp) void CodeMove(register struct desig *rhs, register struct node *left, struct type *rtp)
{ {
/* Generate code for an assignment. Testing of type /* Generate code for an assignment. Testing of type
compatibility and the like is already done. compatibility and the like is already done.
Go through some (considerable) trouble to see if a BLM can be Go through some (considerable) trouble to see if a BLM can be
generated. generated.
*/ */
t_desig lhs; struct desig lhs;
register t_type *tp = left->nd_type; register struct type *tp = left->nd_type;
int loadedflag = 0; int loadedflag = 0;
lhs = null_desig; lhs = null_desig;
@ -419,7 +419,7 @@ void CodeMove(register t_desig *rhs, register t_node *left, t_type *rtp)
} }
} }
void CodeAddress(register t_desig *ds) void CodeAddress(register struct desig *ds)
{ {
/* Generate code to load the address of the designator described /* Generate code to load the address of the designator described
in "ds" in "ds"
@ -459,7 +459,7 @@ void CodeAddress(register t_desig *ds)
ds->dsg_kind = DSG_PLOADED; ds->dsg_kind = DSG_PLOADED;
} }
void CodeFieldDesig(register t_def *df, register t_desig *ds) void CodeFieldDesig(register struct def *df, register struct desig *ds)
{ {
/* Generate code for a field designator. Only the code common for /* Generate code for a field designator. Only the code common for
address as well as value computation is generated, and the address as well as value computation is generated, and the
@ -509,14 +509,14 @@ void CodeFieldDesig(register t_def *df, register t_desig *ds)
} }
} }
void CodeVarDesig(register t_def *df, register t_desig *ds) void CodeVarDesig(register struct def *df, register struct desig *ds)
{ {
/* Generate code for a variable represented by a "def" structure. /* Generate code for a variable represented by a "def" structure.
Of course, there are numerous cases: the variable is local, Of course, there are numerous cases: the variable is local,
it is a value parameter, it is a var parameter, it is one of it is a value parameter, it is a var parameter, it is one of
those of an enclosing procedure, or it is global. those of an enclosing procedure, or it is global.
*/ */
register t_scope *sc = df->df_scope; register struct scope *sc = df->df_scope;
int difflevel; int difflevel;
/* Selections from a module are handled earlier, when identifying /* Selections from a module are handled earlier, when identifying
@ -585,12 +585,12 @@ void CodeVarDesig(register t_def *df, register t_desig *ds)
ds->dsg_def = df; ds->dsg_def = df;
} }
void CodeDesig(register t_node *nd, register t_desig *ds) void CodeDesig(register struct node *nd, register struct desig *ds)
{ {
/* Generate code for a designator. Use divide and conquer /* Generate code for a designator. Use divide and conquer
principle principle
*/ */
register t_def *df; register struct def *df;
switch(nd->nd_class) { /* Divide */ switch(nd->nd_class) { /* Divide */
case Def: case Def:

25
lang/m2/comp/desig.h
View file

@ -49,7 +49,6 @@ struct desig {
*/ */
}; };
typedef struct desig t_desig;
/* The next structure describes the designator in a with-statement. /* The next structure describes the designator in a with-statement.
We have a linked list of them, as with-statements may be nested. We have a linked list of them, as with-statements may be nested.
@ -61,7 +60,7 @@ struct withdesig {
struct scope *w_scope; /* scope in which fields of this record struct scope *w_scope; /* scope in which fields of this record
reside reside
*/ */
t_desig w_desig; /* a desig structure for this particular struct desig w_desig; /* a desig structure for this particular
designator designator
*/ */
}; };
@ -70,20 +69,20 @@ extern struct withdesig *WithDesigs;
#define NO_LABEL ((label) 0) #define NO_LABEL ((label) 0)
typedef struct type t_type; struct type;
typedef struct node t_node; struct node;
void LOL(arith offset, arith size); void LOL(arith offset, arith size);
void STL(arith offset, arith size); void STL(arith offset, arith size);
void CodeValue(register t_desig *ds, register t_type *tp); void CodeValue(register struct desig *ds, register struct type *tp);
void ChkForFOR(register t_node *nd); void ChkForFOR(register struct node *nd);
void CodeStore(register t_desig *ds, register t_type *tp); void CodeStore(register struct desig *ds, register struct type *tp);
void CodeCopy(register t_desig *lhs, register t_desig *rhs, arith sz, arith *psize); void CodeCopy(register struct desig *lhs, register struct desig *rhs, arith sz, arith *psize);
void CodeMove(register t_desig *rhs, register t_node *left, t_type *rtp); void CodeMove(register struct desig *rhs, register struct node *left, struct type *rtp);
void CodeAddress(register t_desig *ds); void CodeAddress(register struct desig *ds);
void CodeFieldDesig(register t_def *df, register t_desig *ds); void CodeFieldDesig(register struct def *df, register struct desig *ds);
void CodeVarDesig(register t_def *df, register t_desig *ds); void CodeVarDesig(register struct def *df, register struct desig *ds);
void CodeDesig(register t_node *nd, register t_desig *ds); void CodeDesig(register struct node *nd, register struct desig *ds);
#endif /* DESIG_H_ */ #endif /* DESIG_H_ */

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

@ -37,15 +37,15 @@
#include "f_info.h" #include "f_info.h"
static t_def *DoImport(register t_def *, t_scope *, int); static struct def *DoImport(register struct def *, struct scope *, int);
t_def *Enter(char *name, int kind, t_type *type, int pnam) struct def *Enter(char *name, int kind, struct type *type, int pnam)
{ {
/* Enter a definition for "name" with kind "kind" and type /* Enter a definition for "name" with kind "kind" and type
"type" in the Current Scope. If it is a standard name, also "type" in the Current Scope. If it is a standard name, also
put its number in the definition structure. put its number in the definition structure.
*/ */
register t_def *df; register struct def *df;
df = define(str2idf(name, 0), CurrentScope, kind); df = define(str2idf(name, 0), CurrentScope, kind);
df->df_type = type; df->df_type = type;
@ -56,7 +56,7 @@ t_def *Enter(char *name, int kind, t_type *type, int pnam)
return df; return df;
} }
t_def *EnterType(char *name, t_type *type) struct def *EnterType(char *name, struct type *type)
{ {
/* Enter a type definition for "name" and type /* Enter a type definition for "name" and type
"type" in the Current Scope. "type" in the Current Scope.
@ -65,7 +65,7 @@ t_def *EnterType(char *name, t_type *type)
return Enter(name, D_TYPE, type, 0); return Enter(name, D_TYPE, type, 0);
} }
void EnterEnumList(t_node *Idlist, register t_type *type) void EnterEnumList(struct node *Idlist, register struct type *type)
{ {
/* Put a list of enumeration literals in the symbol table. /* Put a list of enumeration literals in the symbol table.
They all have type "type". They all have type "type".
@ -74,8 +74,8 @@ void EnterEnumList(t_node *Idlist, register t_type *type)
be exported, in which case its literals must also be exported. be exported, in which case its literals must also be exported.
Thus, we need an easy way to get to them. Thus, we need an easy way to get to them.
*/ */
register t_def *df, *df1 = 0; register struct def *df, *df1 = 0;
register t_node *idlist = Idlist; register struct node *idlist = Idlist;
type->enm_ncst = 0; type->enm_ncst = 0;
for (; idlist; idlist = idlist->nd_NEXT) { for (; idlist; idlist = idlist->nd_NEXT) {
@ -91,7 +91,7 @@ void EnterEnumList(t_node *Idlist, register t_type *type)
FreeNode(Idlist); FreeNode(Idlist);
} }
void EnterFieldList(t_node *Idlist, register t_type *type, t_scope *scope, void EnterFieldList(struct node *Idlist, register struct type *type, struct scope *scope,
arith *addr) arith *addr)
{ {
/* Put a list of fields in the symbol table. /* Put a list of fields in the symbol table.
@ -99,8 +99,8 @@ void EnterFieldList(t_node *Idlist, register t_type *type, t_scope *scope,
Mark them as QUALIFIED EXPORT, because that's exactly what Mark them as QUALIFIED EXPORT, because that's exactly what
fields are, you can get to them by qualifying them. fields are, you can get to them by qualifying them.
*/ */
register t_def *df; register struct def *df;
register t_node *idlist = Idlist; register struct node *idlist = Idlist;
for (; idlist; idlist = idlist->nd_NEXT) { for (; idlist; idlist = idlist->nd_NEXT) {
df = define(idlist->nd_IDF, scope, D_FIELD); df = define(idlist->nd_IDF, scope, D_FIELD);
@ -112,11 +112,11 @@ void EnterFieldList(t_node *Idlist, register t_type *type, t_scope *scope,
FreeNode(Idlist); FreeNode(Idlist);
} }
void EnterVarList(t_node *Idlist, t_type *type, int local) void EnterVarList(struct node *Idlist, struct type *type, int local)
{ {
register t_def *df; register struct def *df;
register t_node *idlist = Idlist; register struct node *idlist = Idlist;
register t_scopelist *sc = CurrVis; register struct scopelist *sc = CurrVis;
char buf[256]; char buf[256];
extern char *sprint(); extern char *sprint();
@ -133,7 +133,7 @@ void EnterVarList(t_node *Idlist, t_type *type, int local)
if (idlist->nd_LEFT->nd_NEXT) { if (idlist->nd_LEFT->nd_NEXT) {
/* An address was supplied /* An address was supplied
*/ */
register t_type *tp = idlist->nd_LEFT->nd_NEXT->nd_type; register struct type *tp = idlist->nd_LEFT->nd_NEXT->nd_type;
df->df_flags |= D_ADDRGIVEN | D_NOREG; df->df_flags |= D_ADDRGIVEN | D_NOREG;
if (tp != error_type && !(tp->tp_fund & T_CARDINAL)){ if (tp != error_type && !(tp->tp_fund & T_CARDINAL)){
@ -180,17 +180,17 @@ void EnterVarList(t_node *Idlist, t_type *type, int local)
FreeNode(Idlist); FreeNode(Idlist);
} }
void EnterParamList(t_param **ppr, void EnterParamList(struct paramlist **ppr,
t_node *Idlist, struct node *Idlist,
t_type *type, struct type *type,
int VARp, int VARp,
arith *off) arith *off)
{ {
register t_param *pr; register struct paramlist *pr;
register t_def *df; register struct def *df;
register t_node *idlist = Idlist; register struct node *idlist = Idlist;
t_node *dummy = 0; struct node *dummy = 0;
static t_param *last; static struct paramlist *last;
if (! idlist) { if (! idlist) {
/* Can only happen when a procedure type is defined */ /* Can only happen when a procedure type is defined */
@ -230,14 +230,14 @@ void EnterParamList(t_param **ppr,
} }
static void ImportEffects(register t_def *idef, t_scope *scope, int flag) static void ImportEffects(register struct def *idef, struct scope *scope, int flag)
{ {
/* Handle side effects of an import: /* Handle side effects of an import:
- a module could have unqualified exports ??? - a module could have unqualified exports ???
- importing an enumeration type also imports literals - importing an enumeration type also imports literals
*/ */
register t_def *df = idef; register struct def *df = idef;
register t_type *tp; register struct type *tp;
while ((df->df_kind & D_IMPORTED) && df->imp_def != df) { while ((df->df_kind & D_IMPORTED) && df->imp_def != df) {
/* The second condition could occur on some (erroneous and /* The second condition could occur on some (erroneous and
@ -262,7 +262,7 @@ static void ImportEffects(register t_def *idef, t_scope *scope, int flag)
in some way, don't do it again; we don't want in some way, don't do it again; we don't want
a multiple defined error message here. a multiple defined error message here.
*/ */
t_def *df1; struct def *df1;
df->df_flags |= D_QEXPORTED; df->df_flags |= D_QEXPORTED;
if ((!(df1 = lookup(df->df_idf, scope, D_IMPORT, 0)) || if ((!(df1 = lookup(df->df_idf, scope, D_IMPORT, 0)) ||
@ -296,11 +296,11 @@ static void ImportEffects(register t_def *idef, t_scope *scope, int flag)
} }
} }
static t_def *DoImport(register t_def *df, t_scope *scope, int flag) static struct def *DoImport(register struct def *df, struct scope *scope, int flag)
{ {
/* Definition "df" is imported to scope "scope". /* Definition "df" is imported to scope "scope".
*/ */
register t_def *idef = define(df->df_idf, scope, D_IMPORT); register struct def *idef = define(df->df_idf, scope, D_IMPORT);
idef->imp_def = df; idef->imp_def = df;
idef->df_flags |= flag; idef->df_flags |= flag;
@ -309,13 +309,13 @@ static t_def *DoImport(register t_def *df, t_scope *scope, int flag)
} }
static void ForwModule(register t_def *df, t_node *nd) static void ForwModule(register struct def *df, struct node *nd)
{ {
/* An import is done from a not yet defined module "df". /* An import is done from a not yet defined module "df".
We could also end up here for not found DEFINITION MODULES. We could also end up here for not found DEFINITION MODULES.
Create a declaration and a scope for this module. Create a declaration and a scope for this module.
*/ */
register t_scopelist *vis; register struct scopelist *vis;
if (df->df_scope != GlobalScope) { if (df->df_scope != GlobalScope) {
df->df_scope = enclosing(CurrVis)->sc_scope; df->df_scope = enclosing(CurrVis)->sc_scope;
@ -334,12 +334,12 @@ static void ForwModule(register t_def *df, t_node *nd)
df->for_node = nd; df->for_node = nd;
} }
static t_def *ForwDef(register t_node *ids, t_scope *scope) static struct def *ForwDef(register struct node *ids, struct scope *scope)
{ {
/* Enter a forward definition of "ids" in scope "scope", /* Enter a forward definition of "ids" in scope "scope",
if it is not already defined. if it is not already defined.
*/ */
register t_def *df; register struct def *df;
if (!(df = lookup(ids->nd_IDF, scope, 0, 0))) { if (!(df = lookup(ids->nd_IDF, scope, 0, 0))) {
df = define(ids->nd_IDF, scope, D_FORWARD); df = define(ids->nd_IDF, scope, D_FORWARD);
@ -350,10 +350,10 @@ static t_def *ForwDef(register t_node *ids, t_scope *scope)
return df; return df;
} }
void EnterExportList(t_node *Idlist, int qualified) void EnterExportList(struct node *Idlist, int qualified)
{ {
register t_node *idlist = Idlist; register struct node *idlist = Idlist;
register t_def *df, *df1; register struct def *df, *df1;
for (;idlist; idlist = idlist->nd_NEXT) { for (;idlist; idlist = idlist->nd_NEXT) {
df = lookup(idlist->nd_IDF, CurrentScope, 0, 0); df = lookup(idlist->nd_IDF, CurrentScope, 0, 0);
@ -400,7 +400,7 @@ void EnterExportList(t_node *Idlist, int qualified)
scope. There are two legal possibilities, scope. There are two legal possibilities,
which are examined below. which are examined below.
*/ */
t_def *df2 = df; struct def *df2 = df;
while (df2->df_kind & D_IMPORTED) { while (df2->df_kind & D_IMPORTED) {
df2 = df2->imp_def; df2 = df2->imp_def;
@ -426,16 +426,16 @@ void EnterExportList(t_node *Idlist, int qualified)
FreeNode(Idlist); FreeNode(Idlist);
} }
void CheckForImports(t_def *df) void CheckForImports(struct def *df)
{ {
/* We have a definition for "df"; check all imports of /* We have a definition for "df"; check all imports of
it for side-effects it for side-effects
*/ */
register t_def *df1 = df->df_idf->id_def; register struct def *df1 = df->df_idf->id_def;
while (df1) { while (df1) {
if (df1->df_kind & D_IMPORTED) { if (df1->df_kind & D_IMPORTED) {
register t_def *df2 = df1->imp_def; register struct def *df2 = df1->imp_def;
while (df2->df_kind & D_IMPORTED) df2 = df2->imp_def; while (df2->df_kind & D_IMPORTED) df2 = df2->imp_def;
if (df2 == df) { if (df2 == df) {
@ -446,12 +446,12 @@ void CheckForImports(t_def *df)
} }
} }
void EnterFromImportList(t_node *idlist, t_def *FromDef, t_node *FromId) void EnterFromImportList(struct node *idlist, struct def *FromDef, struct node *FromId)
{ {
/* Import the list Idlist from the module indicated by Fromdef. /* Import the list Idlist from the module indicated by Fromdef.
*/ */
t_scope *sc; struct scope *sc;
register t_def *df; register struct def *df;
char *module_name = FromDef->df_idf->id_text; char *module_name = FromDef->df_idf->id_text;
switch(FromDef->df_kind) { switch(FromDef->df_kind) {
@ -504,13 +504,13 @@ node_error(FromId,"identifier \"%s\" does not represent a module",module_name);
FreeNode(FromId); FreeNode(FromId);
} }
void EnterImportList(t_node *idlist, int local, t_scope *sc) void EnterImportList(struct node *idlist, int local, struct scope *sc)
{ {
/* Import "idlist" from scope "sc". /* Import "idlist" from scope "sc".
If the import is not local, definition modules must be read If the import is not local, definition modules must be read
for "idlist". for "idlist".
*/ */
extern t_def *GetDefinitionModule(); extern struct def *GetDefinitionModule();
struct f_info f; struct f_info f;
f = file_info; f = file_info;

30
lang/m2/comp/enter.h
View file

@ -9,38 +9,38 @@
#define ENTER_H_ #define ENTER_H_
/* Forward declarations. */ /* Forward declarations. */
typedef struct type t_type; struct type;
typedef struct def t_def; struct node;
typedef struct node t_node; struct scope;
typedef struct scope t_scope; struct paramlist;
typedef struct paramlist t_param; struct def;
t_def *Enter(char *name, int kind, t_type *type, int pnam); struct def *Enter(char *name, int kind, struct type *type, int pnam);
t_def *EnterType(char *name, t_type *type); struct def *EnterType(char *name, struct type *type);
void EnterEnumList(t_node *Idlist, register t_type *type); void EnterEnumList(struct node *Idlist, register struct type *type);
void EnterFieldList(t_node *Idlist, register t_type *type, t_scope *scope, void EnterFieldList(struct node *Idlist, register struct type *type, struct scope *scope,
arith *addr); arith *addr);
/* Enter a list of identifiers representing variables into the /* Enter a list of identifiers representing variables into the
name list. "type" represents the type of the variables. name list. "type" represents the type of the variables.
"local" is set if the variables are declared local to a "local" is set if the variables are declared local to a
procedure. procedure.
*/ */
void EnterVarList(t_node *Idlist, t_type *type, int local); void EnterVarList(struct node *Idlist, struct type *type, int local);
/* Create (part of) a parameterlist of a procedure. /* Create (part of) a parameterlist of a procedure.
"ids" indicates the list of identifiers, "tp" their type, and "ids" indicates the list of identifiers, "tp" their type, and
"VARp" indicates D_VARPAR or D_VALPAR. "VARp" indicates D_VARPAR or D_VALPAR.
*/ */
void EnterParamList(t_param **ppr, t_node *Idlist, t_type *type, void EnterParamList(struct paramlist **ppr, struct node *Idlist, struct type *type,
int VARp, arith *off); int VARp, arith *off);
/* From the current scope, the list of identifiers "ids" is /* From the current scope, the list of identifiers "ids" is
exported. Note this fact. If the export is not qualified, make exported. Note this fact. If the export is not qualified, make
all the "ids" visible in the enclosing scope by defining them all the "ids" visible in the enclosing scope by defining them
in this scope as "imported". in this scope as "imported".
*/ */
void EnterExportList(t_node *Idlist, int qualified); void EnterExportList(struct node *Idlist, int qualified);
void CheckForImports(t_def *df); void CheckForImports(struct def *df);
void EnterFromImportList(t_node *idlist, t_def *FromDef, t_node *FromId); void EnterFromImportList(struct node *idlist, struct def *FromDef, struct node *FromId);
void EnterImportList(t_node *idlist, int local, t_scope *sc); void EnterImportList(struct node *idlist, int local, struct scope *sc);
#endif /* ENTER_H_ */ #endif /* ENTER_H_ */

12
lang/m2/comp/error.c
View file

@ -62,7 +62,7 @@ extern char *symbol2str();
FileName, node errors get their information from the FileName, node errors get their information from the
node, whereas other errors use the information in the token. node, whereas other errors use the information in the token.
*/ */
static void _error(int, t_node *, char *, register va_list, int); static void _error(int, struct node *, char *, register va_list, int);
#if __STDC__ #if __STDC__
#ifdef DEBUG #ifdef DEBUG
@ -92,7 +92,7 @@ void error(char *fmt, ...)
} }
/*VARARGS*/ /*VARARGS*/
void node_error(t_node *node, char *fmt, ...) void node_error(struct node *node, char *fmt, ...)
{ {
va_list ap; va_list ap;
@ -116,7 +116,7 @@ void warning(int class, char *fmt, ...)
} }
/*VARARGS*/ /*VARARGS*/
void node_warning(t_node *node, int class, char *fmt, ...) void node_warning(struct node *node, int class, char *fmt, ...)
{ {
va_list ap; va_list ap;
@ -219,7 +219,7 @@ void node_error(va_alist)
va_start(ap); va_start(ap);
{ {
t_node *node = va_arg(ap, t_node *); struct node *node = va_arg(ap, struct node *);
char *fmt = va_arg(ap, char *); char *fmt = va_arg(ap, char *);
_error(ERROR, node, fmt, ap, 0); _error(ERROR, node, fmt, ap, 0);
} }
@ -249,7 +249,7 @@ void node_warning(va_alist)
va_start(ap); va_start(ap);
{ {
t_node *nd = va_arg(ap, t_node *); struct node *nd = va_arg(ap, struct node *);
int class = va_arg(ap, int); int class = va_arg(ap, int);
char *fmt = va_arg(ap, char *); char *fmt = va_arg(ap, char *);
_error(WARNING, nd, fmt, ap, class); _error(WARNING, nd, fmt, ap, class);
@ -321,7 +321,7 @@ void crash(va_alist)
} }
#endif #endif
static void _error(int class, t_node *node, char *fmt, register va_list ap, int warn_class) static void _error(int class, struct node *node, char *fmt, register va_list ap, int warn_class)
{ {
/* _error attempts to limit the number of error messages /* _error attempts to limit the number of error messages
for a given line to MAXERR_LINE. for a given line to MAXERR_LINE.

6
lang/m2/comp/error.h
View file

@ -8,7 +8,7 @@
#ifndef ERROR_H_ #ifndef ERROR_H_
#define ERROR_H_ #define ERROR_H_
typedef struct node t_node; struct node;
#if __STDC__ #if __STDC__
#ifdef DEBUG #ifdef DEBUG
@ -19,11 +19,11 @@ void debug(char *fmt, ...);
/*VARARGS*/ /*VARARGS*/
void error(char *fmt, ...); void error(char *fmt, ...);
/*VARARGS*/ /*VARARGS*/
void node_error(t_node *node, char *fmt, ...); void node_error(struct node *node, char *fmt, ...);
/*VARARGS*/ /*VARARGS*/
void warning(int class, char *fmt, ...); void warning(int class, char *fmt, ...);
/*VARARGS*/ /*VARARGS*/
void node_warning(t_node *node, int class, char *fmt, ...); void node_warning(struct node *node, int class, char *fmt, ...);
/*VARARGS*/ /*VARARGS*/
void lexerror(char *fmt, ...); void lexerror(char *fmt, ...);
/*VARARGS*/ /*VARARGS*/

46
lang/m2/comp/expression.g
View file

@ -31,7 +31,7 @@ extern char options[];
} }
/* inline, we need room for pdp/11 /* inline, we need room for pdp/11
number(t_node **p;) : number(struct node **p;) :
[ [
%default %default
INTEGER INTEGER
@ -43,7 +43,7 @@ number(t_node **p;) :
; ;
*/ */
qualident(t_node **p;) qualident(struct node **p;)
{ {
} : } :
IDENT { *p = dot2leaf(Name); } IDENT { *p = dot2leaf(Name); }
@ -52,16 +52,16 @@ qualident(t_node **p;)
]* ]*
; ;
selector(register t_node **pnd;) selector(register struct node **pnd;)
{ t_node *nd; { struct node *nd;
} : } :
'.' { nd = dot2leaf(Select); nd->nd_NEXT = *pnd; *pnd = nd; } '.' { nd = dot2leaf(Select); nd->nd_NEXT = *pnd; *pnd = nd; }
IDENT { (*pnd)->nd_IDF = dot.TOK_IDF; } IDENT { (*pnd)->nd_IDF = dot.TOK_IDF; }
; ;
ExpList(t_node **pnd;) ExpList(struct node **pnd;)
{ {
register t_node *nd; register struct node *nd;
} : } :
expression(pnd) { *pnd = nd = dot2node(Link,*pnd,NULLNODE); expression(pnd) { *pnd = nd = dot2node(Link,*pnd,NULLNODE);
nd->nd_symb = ','; nd->nd_symb = ',';
@ -74,7 +74,7 @@ ExpList(t_node **pnd;)
]* ]*
; ;
ConstExpression(register t_node **pnd;) ConstExpression(register struct node **pnd;)
{ {
}: }:
expression(pnd) expression(pnd)
@ -98,7 +98,7 @@ ConstExpression(register t_node **pnd;)
} }
; ;
expression(register t_node **pnd;) expression(register struct node **pnd;)
{ {
} : } :
SimpleExpression(pnd) SimpleExpression(pnd)
@ -117,9 +117,9 @@ relation:
; ;
*/ */
SimpleExpression(register t_node **pnd;) SimpleExpression(register struct node **pnd;)
{ {
register t_node *nd = 0; register struct node *nd = 0;
} : } :
[ [
[ '+' | '-' ] [ '+' | '-' ]
@ -150,9 +150,9 @@ AddOperator:
; ;
*/ */
term(t_node **pnd;) term(struct node **pnd;)
{ {
register t_node *nd; register struct node *nd;
}: }:
factor(pnd) { nd = *pnd; } factor(pnd) { nd = *pnd; }
[ [
@ -170,10 +170,10 @@ MulOperator:
; ;
*/ */
factor(register t_node **p;) factor(register struct node **p;)
{ {
register t_node *nd; register struct node *nd;
t_node *nd1; struct node *nd1;
} : } :
qualident(p) qualident(p)
[ [
@ -224,9 +224,9 @@ factor(register t_node **p;)
factor(&((*p)->nd_RIGHT)) factor(&((*p)->nd_RIGHT))
; ;
bare_set(t_node **pnd;) bare_set(struct node **pnd;)
{ {
register t_node *nd; register struct node *nd;
} : } :
'{' { DOT = SET; '{' { DOT = SET;
*pnd = nd = dot2leaf(Xset); *pnd = nd = dot2leaf(Xset);
@ -242,11 +242,11 @@ bare_set(t_node **pnd;)
'}' '}'
; ;
ActualParameters(t_node **pnd;): ActualParameters(struct node **pnd;):
'(' ExpList(pnd)? ')' '(' ExpList(pnd)? ')'
; ;
element(register t_node *nd;) : element(register struct node *nd;) :
expression(&(nd->nd_RIGHT)) expression(&(nd->nd_RIGHT))
[ [
UPTO UPTO
@ -259,13 +259,13 @@ element(register t_node *nd;) :
} }
; ;
designator(t_node **pnd;) designator(struct node **pnd;)
: :
qualident(pnd) qualident(pnd)
designator_tail(pnd) designator_tail(pnd)
; ;
designator_tail(register t_node **pnd;): designator_tail(register struct node **pnd;):
visible_designator_tail(pnd) visible_designator_tail(pnd)
[ %persistent [ %persistent
%default %default
@ -276,9 +276,9 @@ designator_tail(register t_node **pnd;):
| |
; ;
visible_designator_tail(t_node **pnd;) visible_designator_tail(struct node **pnd;)
{ {
register t_node *nd = *pnd; register struct node *nd = *pnd;
}: }:
'[' { nd = dot2node(Arrsel, nd, NULLNODE); } '[' { nd = dot2node(Arrsel, nd, NULLNODE); }
expression(&(nd->nd_RIGHT)) expression(&(nd->nd_RIGHT))

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

@ -20,4 +20,4 @@ struct id_u {
#include <idf_pkg.spec> #include <idf_pkg.spec>
typedef struct idf t_idf;

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

@ -30,14 +30,14 @@ extern int pass_1;
extern char options[]; extern char options[];
#endif #endif
t_def *lookup(register t_idf *id, t_scope *scope, int import, int flags) struct def *lookup(register struct idf *id, struct scope *scope, int import, int flags)
{ {
/* Look up a definition of an identifier in scope "scope". /* Look up a definition of an identifier in scope "scope".
Make the "def" list self-organizing. Make the "def" list self-organizing.
Return a pointer to its "def" structure if it exists, Return a pointer to its "def" structure if it exists,
otherwise return 0. otherwise return 0.
*/ */
register t_def *df, *df1; register struct def *df, *df1;
/* Look in the chain of definitions of this "id" for one with scope /* Look in the chain of definitions of this "id" for one with scope
"scope". "scope".
@ -72,15 +72,15 @@ t_def *lookup(register t_idf *id, t_scope *scope, int import, int flags)
return df; return df;
} }
t_def *lookfor(register t_node *id, register t_scopelist *vis, int message, int flags) struct def *lookfor(register struct node *id, register struct scopelist *vis, int message, int flags)
{ {
/* Look for an identifier in the visibility range started by "vis". /* Look for an identifier in the visibility range started by "vis".
If it is not defined create a dummy definition and, If it is not defined create a dummy definition and,
if message is set, give an error message if message is set, give an error message
*/ */
register t_scopelist *sc; register struct scopelist *sc;
t_scopelist *sc1 = 0; struct scopelist *sc1 = 0;
t_def *df; struct def *df;
for (sc = vis; sc; sc = nextvisible(sc)) { for (sc = vis; sc; sc = nextvisible(sc)) {
df = lookup(id->nd_IDF, sc->sc_scope, D_IMPORTED, flags); df = lookup(id->nd_IDF, sc->sc_scope, D_IMPORTED, flags);

14
lang/m2/comp/lookup.h
View file

@ -9,13 +9,13 @@
#define LOOKUP_H_ #define LOOKUP_H_
/* Forward declarations. */ /* Forward declarations. */
typedef struct idf t_idf; struct idf;
typedef struct scope t_scope; struct scope;
typedef struct node t_node; struct node;
typedef struct def t_def; struct scopelist;
typedef struct scopelist t_scopelist; struct def;
t_def *lookup(register t_idf *id, t_scope *scope, int import, int flags); struct def *lookup(register struct idf *id, struct scope *scope, int import, int flags);
t_def *lookfor(register t_node *id, register t_scopelist *vis, int message, int flags); struct def *lookfor(register struct node *id, register struct scopelist *vis, int message, int flags);
#endif /* LOOKUP_H_ */ #endif /* LOOKUP_H_ */

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

@ -47,11 +47,11 @@ char *ProgName;
char **DEFPATH; char **DEFPATH;
int nDEF = 2, mDEF = 10; int nDEF = 2, mDEF = 10;
int pass_1 = 1; int pass_1 = 1;
t_def *Defined; struct def *Defined;
extern int err_occurred; extern int err_occurred;
extern int fp_used; /* set if floating point used */ extern int fp_used; /* set if floating point used */
static t_node _emptystat = { Stat, 0, NULLTYPE, { ';' }}; static struct node _emptystat = { Stat, 0, NULLTYPE, { ';' }};
t_node *EmptyStatement = &_emptystat; struct node *EmptyStatement = &_emptystat;
/* Forward declarations. */ /* Forward declarations. */
@ -211,7 +211,7 @@ static struct stdproc sysprocs[] = {
{ 0, 0 } { 0, 0 }
}; };
extern t_def *Enter(), *EnterType(); extern struct def *Enter(), *EnterType();
static void AddProcs(register struct stdproc *p) static void AddProcs(register struct stdproc *p)
{ {
@ -224,7 +224,7 @@ static void AddProcs(register struct stdproc *p)
static void AddStandards(void) static void AddStandards(void)
{ {
register t_def *df; register struct def *df;
static t_token nilconst = { INTEGER, 0}; static t_token nilconst = { INTEGER, 0};
AddProcs(stdprocs); AddProcs(stdprocs);

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

@ -25,7 +25,7 @@
#include "node.h" #include "node.h"
#include "error.h" #include "error.h"
void match_id(register t_idf *id1, t_idf *id2) void match_id(register struct idf *id1, struct idf *id2)
{ {
/* Check that identifiers id1 and id2 are equal. If they /* Check that identifiers id1 and id2 are equal. If they
are not, check that we did'nt generate them in the are not, check that we did'nt generate them in the
@ -39,7 +39,7 @@ void match_id(register t_idf *id1, t_idf *id2)
} }
} }
t_idf *gen_anon_idf(void) struct idf *gen_anon_idf(void)
{ {
/* A new idf is created out of nowhere, to serve as an /* A new idf is created out of nowhere, to serve as an
anonymous name. anonymous name.
@ -54,7 +54,7 @@ t_idf *gen_anon_idf(void)
return str2idf(s, 0); return str2idf(s, 0);
} }
void not_declared(char *what, t_node *id, char *where) void not_declared(char *what, struct node *id, char *where)
{ {
/* The identifier "id" is not declared. If it is not generated, /* The identifier "id" is not declared. If it is not generated,
give an error message give an error message

10
lang/m2/comp/misc.h
View file

@ -13,9 +13,9 @@
#define id_not_declared(x) (not_declared("identifier", (x), "")) #define id_not_declared(x) (not_declared("identifier", (x), ""))
/* Forward declarations. */ /* Forward declarations. */
typedef struct idf t_idf; struct idf;
typedef struct node t_node; struct node;
void match_id(register t_idf *id1, t_idf *id2); void match_id(register struct idf *id1, struct idf *id2);
t_idf *gen_anon_idf(void); struct idf *gen_anon_idf(void);
void not_declared(char *what, t_node *id, char *where); void not_declared(char *what, struct node *id, char *where);

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

@ -40,9 +40,9 @@ static int nsubnodes[] = {
2 2
}; };
t_node *getnode(int class) struct node *getnode(int class)
{ {
register t_node *nd = new_node(); register struct node *nd = new_node();
if (options['R']) nd->nd_flags |= ROPTION; if (options['R']) nd->nd_flags |= ROPTION;
if (options['A']) nd->nd_flags |= AOPTION; if (options['A']) nd->nd_flags |= AOPTION;
@ -50,9 +50,9 @@ t_node *getnode(int class)
return nd; return nd;
} }
t_node *dot2node(int class, t_node *left, t_node *right) struct node *dot2node(int class, struct node *left, struct node *right)
{ {
register t_node *nd = getnode(class); register struct node *nd = getnode(class);
nd->nd_symb = dot.tk_symb; nd->nd_symb = dot.tk_symb;
nd->nd_lineno = dot.tk_lineno; nd->nd_lineno = dot.tk_lineno;
@ -61,9 +61,9 @@ t_node *dot2node(int class, t_node *left, t_node *right)
return nd; return nd;
} }
t_node *dot2leaf(int class) struct node *dot2leaf(int class)
{ {
register t_node *nd = getnode(class); register struct node *nd = getnode(class);
nd->nd_token = dot; nd->nd_token = dot;
switch(nsubnodes[class]) { switch(nsubnodes[class]) {
@ -78,7 +78,7 @@ t_node *dot2leaf(int class)
return nd; return nd;
} }
void FreeNode(register t_node *nd) void FreeNode(register struct node *nd)
{ {
/* Put nodes that are no longer needed back onto the free /* Put nodes that are no longer needed back onto the free
list list
@ -97,13 +97,13 @@ void FreeNode(register t_node *nd)
} }
/*ARGSUSED*/ /*ARGSUSED*/
int NodeCrash(register t_node* expp, label exit_label, int end_reached) int NodeCrash(register struct node* expp, label exit_label, int end_reached)
{ {
crash("(NodeCrash) Illegal node"); crash("(NodeCrash) Illegal node");
} }
/*ARGSUSED*/ /*ARGSUSED*/
int PNodeCrash(t_node **expp, int flags) int PNodeCrash(struct node **expp, int flags)
{ {
crash("(PNodeCrash) Illegal node"); crash("(PNodeCrash) Illegal node");
} }
@ -119,7 +119,7 @@ void indnt(int lvl)
} }
} }
void printnode(register t_node *nd, int lvl) void printnode(register struct node *nd, int lvl)
{ {
indnt(lvl); indnt(lvl);
print("Class: %d; Symbol: %s; Flags: %d\n", nd->nd_class, symbol2str(nd->nd_symb), nd->nd_flags); print("Class: %d; Symbol: %s; Flags: %d\n", nd->nd_class, symbol2str(nd->nd_symb), nd->nd_flags);
@ -131,7 +131,7 @@ void printnode(register t_node *nd, int lvl)
} }
} }
void PrNode(register t_node *nd, int lvl) void PrNode(register struct node *nd, int lvl)
{ {
if (! nd) { if (! nd) {
indnt(lvl); print("<nilnode>\n"); indnt(lvl); print("<nilnode>\n");

26
lang/m2/comp/node.xh
View file

@ -4,10 +4,15 @@
* *
* Author: Ceriel J.H. Jacobs * Author: Ceriel J.H. Jacobs
*/ */
#ifndef NODE_H_
#define NODE_H_
#include "em_arith.h"
#include "em_label.h"
/* N O D E O F A N A B S T R A C T P A R S E T R E E */ /* N O D E O F A N A B S T R A C T P A R S E T R E E */
/* $Id$ */
struct node { struct node {
char nd_class; /* kind of node */ char nd_class; /* kind of node */
@ -47,13 +52,13 @@ struct node {
#define nd_RVAL nd_token.TOK_RVAL #define nd_RVAL nd_token.TOK_RVAL
}; };
typedef struct node t_node;
/* ALLOCDEF "node" 50 */ /* ALLOCDEF "node" 50 */
extern t_node *dot2node(), *dot2leaf(), *getnode(); extern struct node *dot2node(), *dot2leaf(), *getnode();
#define NULLNODE ((t_node *) 0) #define NULLNODE ((struct node *) 0)
#define HASSELECTORS 002 #define HASSELECTORS 002
#define VARIABLE 004 #define VARIABLE 004
@ -64,10 +69,11 @@ extern t_node *dot2node(), *dot2leaf(), *getnode();
t_node *getnode(int class); struct node *getnode(int class);
t_node *dot2node(int class, t_node *left, t_node *right); struct node *dot2node(int class, struct node *left, struct node *right);
t_node *dot2leaf(int class); struct node *dot2leaf(int class);
void FreeNode(register t_node *nd); void FreeNode(register struct node *nd);
int NodeCrash(register t_node* expp, label exit_label, int end_reached); int NodeCrash(register struct node* expp, label exit_label, int end_reached);
int PNodeCrash(t_node **expp, int flags); int PNodeCrash(struct node **expp, int flags);
#endif /* NODE_H_ */

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

@ -36,7 +36,7 @@
#include "warning.h" #include "warning.h"
#include "misc.h" #include "misc.h"
extern t_def *GetDefinitionModule(); extern struct def *GetDefinitionModule();
} }
/* /*
@ -60,8 +60,8 @@ extern t_def *GetDefinitionModule();
ModuleDeclaration ModuleDeclaration
{ {
register t_def *df; register struct def *df;
t_node *exportlist; struct node *exportlist;
int qualified; int qualified;
} : } :
MODULE IDENT { df = DefineLocalModule(dot.TOK_IDF); } MODULE IDENT { df = DefineLocalModule(dot.TOK_IDF); }
@ -76,7 +76,7 @@ ModuleDeclaration
} }
; ;
priority(register t_node **prio;): priority(register struct node **prio;):
[ [
'[' ConstExpression(prio) ']' '[' ConstExpression(prio) ']'
{ if (! ((*prio)->nd_type->tp_fund & T_CARDINAL)) { { if (! ((*prio)->nd_type->tp_fund & T_CARDINAL)) {
@ -87,7 +87,7 @@ priority(register t_node **prio;):
] ]
; ;
export(int *QUALflag; t_node **ExportList;): export(int *QUALflag; struct node **ExportList;):
{ *ExportList = 0; *QUALflag = D_EXPORTED; } { *ExportList = 0; *QUALflag = D_EXPORTED; }
[ [
EXPORT EXPORT
@ -103,9 +103,9 @@ export(int *QUALflag; t_node **ExportList;):
import(int local;) import(int local;)
{ {
t_node *ImportList; struct node *ImportList;
register t_node *FromId = 0; register struct node *FromId = 0;
register t_def *df; register struct def *df;
} : } :
/* /*
When parsing a global module, this is the place where we must When parsing a global module, this is the place where we must
@ -139,13 +139,13 @@ import(int local;)
DefinitionModule DefinitionModule
{ {
register t_def *df; register struct def *df;
t_node *exportlist; struct node *exportlist;
int dummy; int dummy;
extern t_idf *DefId; extern struct idf *DefId;
extern int ForeignFlag; extern int ForeignFlag;
extern char *sprint(); extern char *sprint();
register t_scope *currscope = CurrentScope; register struct scope *currscope = CurrentScope;
char buf[512]; char buf[512];
} : } :
DEFINITION DEFINITION
@ -196,8 +196,8 @@ node_warning(exportlist, W_OLDFASHIONED, "export list in definition module ignor
definition definition
{ {
register t_def *df; register struct def *df;
t_def *dummy; struct def *dummy;
} : } :
CONST [ %persistent ConstantDeclaration ';' ]* CONST [ %persistent ConstantDeclaration ';' ]*
| |
@ -231,7 +231,7 @@ definition
ProgramModule ProgramModule
{ {
register t_def *df; register struct def *df;
} : } :
MODULE MODULE
IDENT IDENT

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

@ -9,7 +9,7 @@
#ifndef SCOPE_H_ #ifndef SCOPE_H_
#define SCOPE_H_ #define SCOPE_H_
struct def;
#define OPENSCOPE 0 /* Indicating an open scope */ #define OPENSCOPE 0 /* Indicating an open scope */
#define CLOSEDSCOPE 1 /* Indicating a closed scope (module) */ #define CLOSEDSCOPE 1 /* Indicating a closed scope (module) */
@ -45,13 +45,12 @@ struct scopelist {
int sc_count; int sc_count;
}; };
typedef struct scope t_scope;
typedef struct scopelist t_scopelist;
extern t_scope
extern struct scope
*PervasiveScope; *PervasiveScope;
extern t_scopelist extern struct scopelist
*CurrVis, *GlobalVis; *CurrVis, *GlobalVis;
#define CurrentScope (CurrVis->sc_scope) #define CurrentScope (CurrVis->sc_scope)
@ -61,15 +60,15 @@ extern t_scopelist
#define nextvisible(x) ((x)->sc_next) /* use with scopelists */ #define nextvisible(x) ((x)->sc_next) /* use with scopelists */
typedef struct def t_def;
void Reverse(t_def **pdf);
void Reverse(struct def **pdf);
void open_scope(int scopetype); void open_scope(int scopetype);
t_scope * open_and_close_scope(int scopetype); struct scope * open_and_close_scope(int scopetype);
void InitScope(void); void InitScope(void);
void close_scope(int flag); void close_scope(int flag);
#ifdef DEBUG #ifdef DEBUG
void DumpScope(register t_def *df); void DumpScope(register struct def *df);
#endif #endif

36
lang/m2/comp/scope.xc
View file

@ -26,8 +26,8 @@
#include "lookup.h" #include "lookup.h"
#include "error.h" #include "error.h"
t_scope *PervasiveScope; struct scope *PervasiveScope;
t_scopelist *CurrVis, *GlobalVis; struct scopelist *CurrVis, *GlobalVis;
extern int proclevel; extern int proclevel;
extern char options[]; extern char options[];
@ -41,8 +41,8 @@ void open_scope(int scopetype)
{ {
/* Open a scope that is either open (automatic imports) or closed. /* Open a scope that is either open (automatic imports) or closed.
*/ */
register t_scope *sc = new_scope(); register struct scope *sc = new_scope();
register t_scopelist *ls = new_scopelist(); register struct scopelist *ls = new_scopelist();
assert(scopetype == OPENSCOPE || scopetype == CLOSEDSCOPE); assert(scopetype == OPENSCOPE || scopetype == CLOSEDSCOPE);
@ -57,9 +57,9 @@ void open_scope(int scopetype)
CurrVis = ls; CurrVis = ls;
} }
t_scope * open_and_close_scope(int scopetype) struct scope * open_and_close_scope(int scopetype)
{ {
t_scope *sc; struct scope *sc;
open_scope(scopetype); open_scope(scopetype);
sc = CurrentScope; sc = CurrentScope;
@ -69,8 +69,8 @@ t_scope * open_and_close_scope(int scopetype)
void InitScope(void) void InitScope(void)
{ {
register t_scope *sc = new_scope(); register struct scope *sc = new_scope();
register t_scopelist *ls = new_scopelist(); register struct scopelist *ls = new_scopelist();
sc->sc_level = proclevel; sc->sc_level = proclevel;
PervasiveScope = sc; PervasiveScope = sc;
@ -78,7 +78,7 @@ void InitScope(void)
CurrVis = ls; CurrVis = ls;
} }
static void chk_proc(register t_def *df) static void chk_proc(register struct def *df)
{ {
/* Called at scope closing. Check all definitions, and if one /* Called at scope closing. Check all definitions, and if one
is a D_PROCHEAD, the procedure was not defined. is a D_PROCHEAD, the procedure was not defined.
@ -100,13 +100,13 @@ static void chk_proc(register t_def *df)
} }
} }
static void chk_forw(t_def **pdf) static void chk_forw(struct def **pdf)
{ {
/* Called at scope close. Look for all forward definitions and /* Called at scope close. Look for all forward definitions and
if the scope was a closed scope, give an error message for if the scope was a closed scope, give an error message for
them, and otherwise move them to the enclosing scope. them, and otherwise move them to the enclosing scope.
*/ */
register t_def *df; register struct def *df;
while ( (df = *pdf) ) { while ( (df = *pdf) ) {
if (df->df_kind == D_FORWTYPE) { if (df->df_kind == D_FORWTYPE) {
@ -131,9 +131,9 @@ df->df_idf->id_text);
Maybe the definitions are in the Maybe the definitions are in the
enclosing scope? enclosing scope?
*/ */
register t_scopelist *ls = register struct scopelist *ls =
nextvisible(CurrVis); nextvisible(CurrVis);
register t_def *df1 = lookup(df->df_idf, ls->sc_scope, 0, 0); register struct def *df1 = lookup(df->df_idf, ls->sc_scope, 0, 0);
*pdf = df->df_nextinscope; *pdf = df->df_nextinscope;
@ -154,14 +154,14 @@ df->df_idf->id_text);
} }
} }
void Reverse(t_def **pdf) void Reverse(struct def **pdf)
{ {
/* Reverse the order in the list of definitions in a scope. /* Reverse the order in the list of definitions in a scope.
This is neccesary because this list is built in reverse. This is neccesary because this list is built in reverse.
Also, while we're at it, remove uninteresting definitions Also, while we're at it, remove uninteresting definitions
from this list. from this list.
*/ */
register t_def *df, *df1; register struct def *df, *df1;
#define INTERESTING (D_MODULE|D_PROCEDURE|D_PROCHEAD|D_VARIABLE|D_IMPORTED|D_TYPE|D_CONST|D_FIELD) #define INTERESTING (D_MODULE|D_PROCEDURE|D_PROCHEAD|D_VARIABLE|D_IMPORTED|D_TYPE|D_CONST|D_FIELD)
df = 0; df = 0;
@ -169,7 +169,7 @@ void Reverse(t_def **pdf)
while (df1) { while (df1) {
if (df1->df_kind & INTERESTING) { if (df1->df_kind & INTERESTING) {
t_def *prev = df; struct def *prev = df;
df = df1; df = df1;
df1 = df1->df_nextinscope; df1 = df1->df_nextinscope;
@ -186,7 +186,7 @@ void close_scope(int flag)
either POINTER declarations, or EXPORTs, or forward references either POINTER declarations, or EXPORTs, or forward references
to MODULES to MODULES
*/ */
register t_scope *sc = CurrentScope; register struct scope *sc = CurrentScope;
assert(sc != 0); assert(sc != 0);
@ -203,7 +203,7 @@ void close_scope(int flag)
} }
#ifdef DEBUG #ifdef DEBUG
void DumpScope(register t_def *df) void DumpScope(register struct def *df)
{ {
while (df) { while (df) {
PrDef(df); PrDef(df);

12
lang/m2/comp/stab.c
View file

@ -68,7 +68,7 @@ static void adds_db_str(char *s)
while (*s) addc_db_str(*s++); while (*s) addc_db_str(*s++);
} }
static void stb_type(register t_type *tp, int assign_num) static void stb_type(register struct type *tp, int assign_num)
{ {
char buf[128]; char buf[128];
static int stb_count; static int stb_count;
@ -249,7 +249,7 @@ static void stb_type(register t_type *tp, int assign_num)
} }
} }
void stb_addtp(char *s, t_type *tp) void stb_addtp(char *s, struct type *tp)
{ {
create_db_str(); create_db_str();
adds_db_str(s); adds_db_str(s);
@ -265,9 +265,9 @@ void stb_addtp(char *s, t_type *tp)
(arith) 0); (arith) 0);
} }
void stb_string(register t_def *df, int kind) void stb_string(register struct def *df, int kind)
{ {
register t_type *tp = df->df_type; register struct type *tp = df->df_type;
char buf[64]; char buf[64];
create_db_str(); create_db_str();
@ -291,10 +291,10 @@ void stb_string(register t_def *df, int kind)
else adds_db_str(sprint(buf, "Q%d;", df->prc_vis->sc_count)); else adds_db_str(sprint(buf, "Q%d;", df->prc_vis->sc_count));
stb_type(tp->tp_next ? tp->tp_next : void_type, 0); stb_type(tp->tp_next ? tp->tp_next : void_type, 0);
if (gdb_flag) { if (gdb_flag) {
t_scopelist *sc = df->prc_vis; struct scopelist *sc = df->prc_vis;
sc = enclosing(sc); sc = enclosing(sc);
while (sc) { while (sc) {
t_def *d = sc->sc_scope->sc_definedby; struct def *d = sc->sc_scope->sc_definedby;
if (d && d->df_kind == D_PROCEDURE) { if (d && d->df_kind == D_PROCEDURE) {
adds_db_str(sprint(buf, ",%s", d->df_idf->id_text)); adds_db_str(sprint(buf, ",%s", d->df_idf->id_text));

8
lang/m2/comp/stab.h
View file

@ -9,11 +9,11 @@
#define STAB_H_ #define STAB_H_
/* D E B U G G E R S Y M B O L T A B L E */ /* D E B U G G E R S Y M B O L T A B L E */
typedef struct type t_type;
typedef struct def t_def;
void stb_addtp(char *s, t_type *tp); struct def;
void stb_string(register t_def *df, int kind);
void stb_addtp(char *s, struct type *tp);
void stb_string(register struct def *df, int kind);
#endif /* STAB_H_ */ #endif /* STAB_H_ */

50
lang/m2/comp/statement.g
View file

@ -24,12 +24,12 @@
#include "node.h" #include "node.h"
static int loopcount = 0; /* Count nested loops */ static int loopcount = 0; /* Count nested loops */
extern t_node *EmptyStatement; extern struct node *EmptyStatement;
} }
statement(register t_node **pnd;) statement(register struct node **pnd;)
{ {
register t_node *nd; register struct node *nd;
extern int return_occurred; extern int return_occurred;
} : } :
/* /*
@ -110,10 +110,10 @@ ProcedureCall:
; ;
*/ */
StatementSequence(register t_node **pnd;) StatementSequence(register struct node **pnd;)
{ {
t_node *nd; struct node *nd;
register t_node *nd1; register struct node *nd1;
} : } :
statement(pnd) statement(pnd)
[ %persistent [ %persistent
@ -129,9 +129,9 @@ StatementSequence(register t_node **pnd;)
]* ]*
; ;
IfStatement(t_node **pnd;) IfStatement(struct node **pnd;)
{ {
register t_node *nd; register struct node *nd;
} : } :
IF { nd = dot2leaf(Stat); IF { nd = dot2leaf(Stat);
*pnd = nd; *pnd = nd;
@ -160,10 +160,10 @@ IfStatement(t_node **pnd;)
END END
; ;
CaseStatement(t_node **pnd;) CaseStatement(struct node **pnd;)
{ {
register t_node *nd; register struct node *nd;
t_type *tp = 0; struct type *tp = 0;
} : } :
CASE { *pnd = nd = dot2leaf(Stat); } CASE { *pnd = nd = dot2leaf(Stat); }
expression(&(nd->nd_LEFT)) expression(&(nd->nd_LEFT))
@ -181,7 +181,7 @@ CaseStatement(t_node **pnd;)
END END
; ;
case(t_node **pnd; t_type **ptp;) : case(struct node **pnd; struct type **ptp;) :
[ CaseLabelList(ptp, pnd) [ CaseLabelList(ptp, pnd)
':' { *pnd = dot2node(Link, *pnd, NULLNODE); } ':' { *pnd = dot2node(Link, *pnd, NULLNODE); }
StatementSequence(&((*pnd)->nd_RIGHT)) StatementSequence(&((*pnd)->nd_RIGHT))
@ -193,9 +193,9 @@ case(t_node **pnd; t_type **ptp;) :
; ;
/* inline in statement; lack of space /* inline in statement; lack of space
WhileStatement(t_node **pnd;) WhileStatement(struct node **pnd;)
{ {
register t_node *nd; register struct node *nd;
}: }:
WHILE { *pnd = nd = dot2leaf(Stat); } WHILE { *pnd = nd = dot2leaf(Stat); }
expression(&(nd->nd_LEFT)) expression(&(nd->nd_LEFT))
@ -204,9 +204,9 @@ WhileStatement(t_node **pnd;)
END END
; ;
RepeatStatement(t_node **pnd;) RepeatStatement(struct node **pnd;)
{ {
register t_node *nd; register struct node *nd;
}: }:
REPEAT { *pnd = nd = dot2leaf(Stat); } REPEAT { *pnd = nd = dot2leaf(Stat); }
StatementSequence(&(nd->nd_LEFT)) StatementSequence(&(nd->nd_LEFT))
@ -215,9 +215,9 @@ RepeatStatement(t_node **pnd;)
; ;
*/ */
ForStatement(t_node **pnd;) ForStatement(struct node **pnd;)
{ {
register t_node *nd, *nd1; register struct node *nd, *nd1;
}: }:
FOR { *pnd = nd = dot2leaf(Stat); } FOR { *pnd = nd = dot2leaf(Stat); }
IDENT { nd1 = dot2leaf(Name); } IDENT { nd1 = dot2leaf(Name); }
@ -249,15 +249,15 @@ ForStatement(t_node **pnd;)
; ;
/* inline in Statement; lack of space /* inline in Statement; lack of space
LoopStatement(t_node **pnd;): LoopStatement(struct node **pnd;):
LOOP { *pnd = dot2leaf(Stat); } LOOP { *pnd = dot2leaf(Stat); }
StatementSequence(&((*pnd)->nd_RIGHT)) StatementSequence(&((*pnd)->nd_RIGHT))
END END
; ;
WithStatement(t_node **pnd;) WithStatement(struct node **pnd;)
{ {
register t_node *nd; register struct node *nd;
}: }:
WITH { *pnd = nd = dot2leaf(Stat); } WITH { *pnd = nd = dot2leaf(Stat); }
designator(&(nd->nd_LEFT)) designator(&(nd->nd_LEFT))
@ -267,11 +267,11 @@ WithStatement(t_node **pnd;)
; ;
*/ */
ReturnStatement(t_node **pnd;) ReturnStatement(struct node **pnd;)
{ {
register t_def *df = CurrentScope->sc_definedby; register struct def *df = CurrentScope->sc_definedby;
register t_type *tp = df->df_type ? ResultType(df->df_type) : 0; register struct type *tp = df->df_type ? ResultType(df->df_type) : 0;
register t_node *nd; register struct node *nd;
} : } :
RETURN { *pnd = nd = dot2leaf(Stat); } RETURN { *pnd = nd = dot2leaf(Stat); }

4
lang/m2/comp/tmpvar.h
View file

@ -11,9 +11,9 @@
#include "em_arith.h" #include "em_arith.h"
typedef struct scope t_scope; struct scope;
void TmpOpen(t_scope *sc); void TmpOpen(struct scope *sc);
arith TmpSpace(arith sz, int al); arith TmpSpace(arith sz, int al);
arith NewInt(void); arith NewInt(void);
arith NewPtr(void); arith NewPtr(void);

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

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

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

@ -104,7 +104,7 @@ void reserve(register struct tokenname *resv)
/* The names of the tokens described in resv are entered /* The names of the tokens described in resv are entered
as reserved words. as reserved words.
*/ */
register t_idf *p; register struct idf *p;
while (resv->tn_symbol) { while (resv->tn_symbol) {
p = str2idf(resv->tn_name, 0); p = str2idf(resv->tn_name, 0);

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

@ -59,7 +59,7 @@ arith
arith ret_area_size; arith ret_area_size;
t_type struct type
*bool_type, *bool_type,
*char_type, *char_type,
*int_type, *int_type,
@ -79,12 +79,12 @@ t_type
*error_type; *error_type;
t_type *construct_type(int fund, register t_type *tp) struct type *construct_type(int fund, register struct type *tp)
{ {
/* fund must be a type constructor. /* fund must be a type constructor.
The pointer to the constructed type is returned. The pointer to the constructed type is returned.
*/ */
register t_type *dtp = new_type(); register struct type *dtp = new_type();
switch (dtp->tp_fund = fund) { switch (dtp->tp_fund = fund) {
case T_PROCEDURE: case T_PROCEDURE:
@ -129,9 +129,9 @@ arith align(arith pos, int al)
return pos; return pos;
} }
t_type *standard_type(int fund, int algn, arith size) struct type *standard_type(int fund, int algn, arith size)
{ {
register t_type *tp = new_type(); register struct type *tp = new_type();
tp->tp_fund = fund; tp->tp_fund = fund;
tp->tp_align = algn; tp->tp_align = algn;
@ -145,7 +145,7 @@ t_type *standard_type(int fund, int algn, arith size)
void InitTypes(void) void InitTypes(void)
{ {
register t_type *tp; register struct type *tp;
/* first, do some checking /* first, do some checking
*/ */
@ -221,7 +221,7 @@ int fit(arith sz, int nbytes)
return ((sz) + ((arith)0x80<<(((nbytes)-1)*8)) & ~full_mask[(nbytes)]) == 0; return ((sz) + ((arith)0x80<<(((nbytes)-1)*8)) & ~full_mask[(nbytes)]) == 0;
} }
static void u_small(register t_type *tp, arith n) static void u_small(register struct type *tp, arith n)
{ {
if (ufit(n, 1)) { if (ufit(n, 1)) {
tp->tp_size = 1; tp->tp_size = 1;
@ -233,9 +233,9 @@ static void u_small(register t_type *tp, arith n)
} }
} }
t_type *enum_type(t_node *EnumList) struct type *enum_type(struct node *EnumList)
{ {
register t_type *tp = register struct type *tp =
standard_type(T_ENUMERATION, int_align, int_size); standard_type(T_ENUMERATION, int_align, int_size);
EnterEnumList(EnumList, tp); EnterEnumList(EnumList, tp);
@ -246,12 +246,12 @@ t_type *enum_type(t_node *EnumList)
return tp; return tp;
} }
t_type *qualified_type(t_node **pnd) struct type *qualified_type(struct node **pnd)
{ {
register t_def *df; register struct def *df;
if (ChkDesig(pnd, D_USED)) { if (ChkDesig(pnd, D_USED)) {
register t_node *nd = *pnd; register struct node *nd = *pnd;
if (nd->nd_class != Def) { if (nd->nd_class != Def) {
node_error(nd, "type expected"); node_error(nd, "type expected");
FreeNode(nd); FreeNode(nd);
@ -291,7 +291,7 @@ int chk_bounds(arith l1, arith l2, int fund)
return (unsigned arith) l2 >= (unsigned arith) l1; return (unsigned arith) l2 >= (unsigned arith) l1;
} }
int in_range(arith i, register t_type *tp) int in_range(arith i, register struct type *tp)
{ {
@ -308,10 +308,10 @@ int in_range(arith i, register t_type *tp)
/*NOTREACHED*/ /*NOTREACHED*/
} }
t_type *subr_type(t_node *lb, t_node *ub, t_type *base) struct type *subr_type(struct node *lb, struct node *ub, struct type *base)
{ {
register t_type *tp = BaseType(lb->nd_type); register struct type *tp = BaseType(lb->nd_type);
register t_type *res; register struct type *res;
if (tp == intorcard_type) { if (tp == intorcard_type) {
/* Lower bound >= 0; in this case, the base type is CARDINAL, /* Lower bound >= 0; in this case, the base type is CARDINAL,
@ -398,9 +398,9 @@ t_type *subr_type(t_node *lb, t_node *ub, t_type *base)
return res; return res;
} }
t_type *proc_type(t_type *result_type, t_param *parameters, arith n_bytes_params) struct type *proc_type(struct type *result_type, struct paramlist *parameters, arith n_bytes_params)
{ {
register t_type *tp = construct_type(T_PROCEDURE, result_type); register struct type *tp = construct_type(T_PROCEDURE, result_type);
tp->prc_params = parameters; tp->prc_params = parameters;
tp->prc_nbpar = n_bytes_params; tp->prc_nbpar = n_bytes_params;
@ -413,7 +413,7 @@ t_type *proc_type(t_type *result_type, t_param *parameters, arith n_bytes_params
return tp; return tp;
} }
void genrck(register t_type *tp) void genrck(register struct type *tp)
{ {
/* generate a range check descriptor for type "tp" when /* generate a range check descriptor for type "tp" when
neccessary. Return its label. neccessary. Return its label.
@ -421,7 +421,7 @@ void genrck(register t_type *tp)
arith lb, ub; arith lb, ub;
register label ol; register label ol;
arith size = tp->tp_size; arith size = tp->tp_size;
register t_type *btp = BaseType(tp); register struct type *btp = BaseType(tp);
if (size < word_size) size = word_size; if (size < word_size) size = word_size;
getbounds(tp, &lb, &ub); getbounds(tp, &lb, &ub);
@ -448,7 +448,7 @@ void genrck(register t_type *tp)
} }
} }
void getbounds(register t_type *tp, arith *plo, arith *phi) void getbounds(register struct type *tp, arith *plo, arith *phi)
{ {
assert(bounded(tp)); assert(bounded(tp));
@ -462,7 +462,7 @@ void getbounds(register t_type *tp, arith *plo, arith *phi)
} }
} }
t_type *set_type(register t_type *tp) struct type *set_type(register struct type *tp)
{ {
arith lb, ub, diff, alloc_size; arith lb, ub, diff, alloc_size;
@ -498,14 +498,14 @@ t_type *set_type(register t_type *tp)
return tp; return tp;
} }
void ArrayElSize(register t_type *tp) void ArrayElSize(register struct type *tp)
{ {
/* Align element size to alignment requirement of element type. /* Align element size to alignment requirement of element type.
Also make sure that its size is either a dividor of the word_size, Also make sure that its size is either a dividor of the word_size,
or a multiple of it. or a multiple of it.
*/ */
register arith algn; register arith algn;
register t_type *elem_type = tp->arr_elem; register struct type *elem_type = tp->arr_elem;
if (elem_type->tp_fund == T_ARRAY) ArraySizes(elem_type); if (elem_type->tp_fund == T_ARRAY) ArraySizes(elem_type);
algn = align(elem_type->tp_size, elem_type->tp_align); algn = align(elem_type->tp_size, elem_type->tp_align);
@ -524,11 +524,11 @@ void ArrayElSize(register t_type *tp)
} }
} }
void ArraySizes(register t_type *tp) void ArraySizes(register struct type *tp)
{ {
/* Assign sizes to an array type, and check index type /* Assign sizes to an array type, and check index type
*/ */
register t_type *index_type = IndexType(tp); register struct type *index_type = IndexType(tp);
arith diff; arith diff;
ArrayElSize(tp); ArrayElSize(tp);
@ -563,13 +563,13 @@ void ArraySizes(register t_type *tp)
C_rom_cst(tp->arr_elsize); C_rom_cst(tp->arr_elsize);
} }
void FreeType(register t_type *tp) void FreeType(register struct type *tp)
{ {
/* Release type structures indicated by "tp". /* Release type structures indicated by "tp".
This procedure is only called for types, constructed with This procedure is only called for types, constructed with
T_PROCEDURE. T_PROCEDURE.
*/ */
register t_param *pr, *pr1; register struct paramlist *pr, *pr1;
assert(tp->tp_fund == T_PROCEDURE); assert(tp->tp_fund == T_PROCEDURE);
@ -584,7 +584,7 @@ void FreeType(register t_type *tp)
free_type(tp); free_type(tp);
} }
void DeclareType(t_node *nd, register t_def *df, register t_type *tp) void DeclareType(struct node *nd, register struct def *df, register struct type *tp)
{ {
/* A type with type-description "tp" is declared and must /* A type with type-description "tp" is declared and must
be bound to definition "df". be bound to definition "df".
@ -592,7 +592,7 @@ void DeclareType(t_node *nd, register t_def *df, register t_type *tp)
"df" is already bound. In that case, it is either an opaque "df" is already bound. In that case, it is either an opaque
type, or an error message was given when "df" was created. type, or an error message was given when "df" was created.
*/ */
register t_type *df_tp = df->df_type; register struct type *df_tp = df->df_type;
if (df_tp && df_tp->tp_fund == T_HIDDEN) { if (df_tp && df_tp->tp_fund == T_HIDDEN) {
if (! (tp->tp_fund & (T_POINTER|T_HIDDEN|T_EQUAL))) { if (! (tp->tp_fund & (T_POINTER|T_HIDDEN|T_EQUAL))) {
@ -626,9 +626,9 @@ void DeclareType(t_node *nd, register t_def *df, register t_type *tp)
SolveForwardTypeRefs(df); SolveForwardTypeRefs(df);
} }
void SolveForwardTypeRefs(register t_def *df) void SolveForwardTypeRefs(register struct def *df)
{ {
register t_node *nd; register struct node *nd;
if (df->df_kind == D_FORWTYPE) { if (df->df_kind == D_FORWTYPE) {
nd = df->df_forw_node; nd = df->df_forw_node;
@ -648,10 +648,10 @@ void SolveForwardTypeRefs(register t_def *df)
} }
void ForceForwardTypeDef(register t_def *df) void ForceForwardTypeDef(register struct def *df)
{ {
register t_def *df1 = df, *df2; register struct def *df1 = df, *df2;
register t_node *nd = df->df_forw_node; register struct node *nd = df->df_forw_node;
while (df && df->df_kind == D_FORWTYPE) { while (df && df->df_kind == D_FORWTYPE) {
RemoveFromIdList(df); RemoveFromIdList(df);
@ -682,20 +682,20 @@ void ForceForwardTypeDef(register t_def *df)
} }
} }
t_type *RemoveEqual(register t_type *tpx) struct type *RemoveEqual(register struct type *tpx)
{ {
if (tpx) while (tpx->tp_fund == T_EQUAL) tpx = tpx->tp_next; if (tpx) while (tpx->tp_fund == T_EQUAL) tpx = tpx->tp_next;
return tpx; return tpx;
} }
int type_or_forward(t_type *tp) int type_or_forward(struct type *tp)
{ {
/* POINTER TO IDENTIFIER construction. The IDENTIFIER resides /* POINTER TO IDENTIFIER construction. The IDENTIFIER resides
in "dot". This routine handles the different cases. in "dot". This routine handles the different cases.
*/ */
register t_node *nd; register struct node *nd;
register t_def *df, *df1; register struct def *df, *df1;
if ((df1 = lookup(dot.TOK_IDF, CurrentScope, D_IMPORTED, D_USED))) { if ((df1 = lookup(dot.TOK_IDF, CurrentScope, D_IMPORTED, D_USED))) {
/* Either a Module or a Type, but in both cases defined /* Either a Module or a Type, but in both cases defined
@ -773,10 +773,10 @@ int lcm(int m, int n)
return m * (n / gcd(m, n)); return m * (n / gcd(m, n));
} }
t_type *intorcard(register t_type *left, register t_type *right) struct type *intorcard(register struct type *left, register struct type *right)
{ {
if (left->tp_fund == T_INTORCARD) { if (left->tp_fund == T_INTORCARD) {
t_type *tmp = left; struct type *tmp = left;
left = right; left = right;
right = tmp; right = tmp;
} }
@ -789,7 +789,7 @@ t_type *intorcard(register t_type *left, register t_type *right)
} }
#ifdef DEBUG #ifdef DEBUG
void DumpType(register t_type *tp) void DumpType(register struct type *tp)
{ {
if (!tp) return; if (!tp) return;
@ -825,7 +825,7 @@ void DumpType(register t_type *tp)
break; break;
case T_PROCEDURE: case T_PROCEDURE:
{ {
register t_param *par = ParamList(tp); register struct paramlist *par = ParamList(tp);
print("PROCEDURE"); print("PROCEDURE");
if (par) { if (par) {

52
lang/m2/comp/type.xh
View file

@ -13,8 +13,8 @@
typedef struct def t_def; struct def;
typedef struct node t_node; struct node;
struct paramlist { /* structure for parameterlist of a PROCEDURE */ struct paramlist { /* structure for parameterlist of a PROCEDURE */
struct paramlist *par_next; struct paramlist *par_next;
@ -23,7 +23,7 @@ struct paramlist { /* structure for parameterlist of a PROCEDURE */
#define TypeOfParam(xpar) ((xpar)->par_def->df_type) #define TypeOfParam(xpar) ((xpar)->par_def->df_type)
}; };
typedef struct paramlist t_param; struct paramlist;
/* ALLOCDEF "paramlist" 20 */ /* ALLOCDEF "paramlist" 20 */
@ -124,11 +124,11 @@ struct type {
} tp_value; } tp_value;
}; };
typedef struct type t_type; struct type;
/* ALLOCDEF "type" 50 */ /* ALLOCDEF "type" 50 */
extern t_type extern struct type
*bool_type, *bool_type,
*char_type, *char_type,
*int_type, *int_type,
@ -198,7 +198,7 @@ extern arith
#define NULLTYPE ((t_type *) 0) #define NULLTYPE ((struct type *) 0)
#define IsConformantArray(tpx) ((tpx)->tp_fund==T_ARRAY && (tpx)->tp_size==0) #define IsConformantArray(tpx) ((tpx)->tp_fund==T_ARRAY && (tpx)->tp_size==0)
#define bounded(tpx) ((tpx)->tp_fund & T_INDEX) #define bounded(tpx) ((tpx)->tp_fund & T_INDEX)
@ -250,37 +250,37 @@ int chk_bounds(arith l1, arith l2, int fund);
arith align(arith pos, int al); arith align(arith pos, int al);
/* Create a new standard type "fund" with specified /* Create a new standard type "fund" with specified
alignment "algn" and "size" bytes. */ alignment "algn" and "size" bytes. */
t_type *standard_type(int fund, int algn, arith size); struct type *standard_type(int fund, int algn, arith size);
t_type *enum_type(t_node *EnumList); struct type *enum_type(struct node *EnumList);
t_type *construct_type(int fund, register t_type *tp); struct type *construct_type(int fund, register struct type *tp);
t_type *qualified_type(t_node **pnd); struct type *qualified_type(struct node **pnd);
/* Check that the value "i" fits in the subrange or enumeration /* Check that the value "i" fits in the subrange or enumeration
type "tp". Return 1 if so, 0 otherwise type "tp". Return 1 if so, 0 otherwise
*/ */
int in_range(arith i, register t_type *tp); int in_range(arith i, register struct type *tp);
/* Construct a subrange type from the constant expressions /* Construct a subrange type from the constant expressions
indicated by "lb" and "ub", but first perform some indicated by "lb" and "ub", but first perform some
checks. "base" is either a user-specified base-type, or NULL. checks. "base" is either a user-specified base-type, or NULL.
*/ */
t_type *subr_type(t_node *lb, t_node *ub, t_type *base); struct type *subr_type(struct node *lb, struct node *ub, struct type *base);
t_type *proc_type(t_type *result_type, t_param *parameters, arith n_bytes_params); struct type *proc_type(struct type *result_type, struct paramlist *parameters, arith n_bytes_params);
void genrck(register t_type *tp); void genrck(register struct type *tp);
/* Get the bounds of a bounded type. */ /* Get the bounds of a bounded type. */
void getbounds(register t_type *tp, arith *plo, arith *phi); void getbounds(register struct type *tp, arith *plo, arith *phi);
/* Construct a set type with base type "tp", but first /* Construct a set type with base type "tp", but first
* perform some checks */ * perform some checks */
t_type *set_type(register t_type *tp); struct type *set_type(register struct type *tp);
void ArrayElSize(register t_type *tp); void ArrayElSize(register struct type *tp);
void ArraySizes(register t_type *tp); void ArraySizes(register struct type *tp);
void FreeType(register t_type *tp); void FreeType(register struct type *tp);
void DeclareType(t_node *nd, register t_def *df, register t_type *tp); void DeclareType(struct node *nd, register struct def *df, register struct type *tp);
void SolveForwardTypeRefs(register t_def *df); void SolveForwardTypeRefs(register struct def *df);
void ForceForwardTypeDef(register t_def *df); void ForceForwardTypeDef(register struct def *df);
t_type *RemoveEqual(register t_type *tpx); struct type *RemoveEqual(register struct type *tpx);
int type_or_forward(t_type *tp); int type_or_forward(struct type *tp);
t_type *intorcard(register t_type *left, register t_type *right); struct type *intorcard(register struct type *left, register struct type *right);
#ifdef DEBUG #ifdef DEBUG
void DumpType(register t_type *tp); void DumpType(register struct type *tp);
#endif #endif
int fit(arith sz, int nbytes); int fit(arith sz, int nbytes);
/* Greatest common divisotr. */ /* Greatest common divisotr. */

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

@ -35,7 +35,7 @@
#include "chk_expr.h" #include "chk_expr.h"
static int TstTypeEquiv(t_type *tp1, t_type *tp2) static int TstTypeEquiv(struct type *tp1, struct type *tp2)
{ {
/* test if two types are equivalent. /* test if two types are equivalent.
*/ */
@ -45,7 +45,7 @@ static int TstTypeEquiv(t_type *tp1, t_type *tp2)
(tp2 == error_type); (tp2 == error_type);
} }
static int TstParEquiv(register t_type *tp1, register t_type *tp2) static int TstParEquiv(register struct type *tp1, register struct type *tp2)
{ {
/* test if two parameter types are equivalent. This routine /* test if two parameter types are equivalent. This routine
is used to check if two different procedure declarations is used to check if two different procedure declarations
@ -66,13 +66,13 @@ static int TstParEquiv(register t_type *tp1, register t_type *tp2)
); );
} }
int TstProcEquiv(t_type *tp1, t_type *tp2) int TstProcEquiv(struct type *tp1, struct type *tp2)
{ {
/* Test if two procedure types are equivalent. This routine /* Test if two procedure types are equivalent. This routine
may also be used for the testing of assignment compatibility may also be used for the testing of assignment compatibility
between procedure variables and procedures. between procedure variables and procedures.
*/ */
register t_param *p1, *p2; register struct paramlist *p1, *p2;
/* First check if the result types are equivalent /* First check if the result types are equivalent
*/ */
@ -96,7 +96,7 @@ int TstProcEquiv(t_type *tp1, t_type *tp2)
return p1 == p2; return p1 == p2;
} }
int TstCompat(register t_type *tp1, register t_type *tp2) int TstCompat(register struct type *tp1, register struct type *tp2)
{ {
/* test if two types are compatible. See section 6.3 of the /* test if two types are compatible. See section 6.3 of the
Modula-2 Report for a definition of "compatible". Modula-2 Report for a definition of "compatible".
@ -108,7 +108,7 @@ int TstCompat(register t_type *tp1, register t_type *tp2)
tp2 = BaseType(tp2); tp2 = BaseType(tp2);
if (tp2->tp_fund != T_INTORCARD && if (tp2->tp_fund != T_INTORCARD &&
(tp1->tp_fund == T_INTORCARD || tp1 == address_type)) { (tp1->tp_fund == T_INTORCARD || tp1 == address_type)) {
t_type *tmp = tp2; struct type *tmp = tp2;
tp2 = tp1; tp2 = tp1;
tp1 = tmp; tp1 = tmp;
@ -133,7 +133,7 @@ int TstCompat(register t_type *tp1, register t_type *tp2)
; ;
} }
int TstAssCompat(register t_type *tp1, register t_type *tp2) int TstAssCompat(register struct type *tp1, register struct type *tp2)
{ {
/* Test if two types are assignment compatible. /* Test if two types are assignment compatible.
See Def 9.1. See Def 9.1.
@ -170,7 +170,7 @@ int TstAssCompat(register t_type *tp1, register t_type *tp2)
return 0; return 0;
} }
char *incompat(register t_type *tp1, register t_type *tp2) char *incompat(register struct type *tp1, register struct type *tp2)
{ {
if (tp1->tp_fund == T_HIDDEN || tp2->tp_fund == T_HIDDEN) { if (tp1->tp_fund == T_HIDDEN || tp2->tp_fund == T_HIDDEN) {
@ -179,7 +179,7 @@ char *incompat(register t_type *tp1, register t_type *tp2)
return "type incompatibility"; return "type incompatibility";
} }
int TstParCompat(int parno, register t_type *formaltype, int VARflag, t_node **nd, t_def *edf) int TstParCompat(int parno, register struct type *formaltype, int VARflag, struct node **nd, struct def *edf)
{ {
/* Check type compatibility for a parameter in a procedure call. /* Check type compatibility for a parameter in a procedure call.
Assignment compatibility may do if the parameter is Assignment compatibility may do if the parameter is
@ -188,7 +188,7 @@ int TstParCompat(int parno, register t_type *formaltype, int VARflag, t_node **n
may do too. may do too.
Or: a WORD may do. Or: a WORD may do.
*/ */
register t_type *actualtype = (*nd)->nd_type; register struct type *actualtype = (*nd)->nd_type;
char ebuf[256]; char ebuf[256];
if (edf) { if (edf) {
@ -255,7 +255,7 @@ int TstParCompat(int parno, register t_type *formaltype, int VARflag, t_node **n
return 0; return 0;
} }
int CompatCheck(register t_node **nd, t_type *tp, char *message, int (*fc)()) int CompatCheck(register struct node **nd, struct type *tp, char *message, int (*fc)())
{ {
if (! (*fc)(tp, (*nd)->nd_type)) { if (! (*fc)(tp, (*nd)->nd_type)) {
if (message) { if (message) {
@ -269,7 +269,7 @@ int CompatCheck(register t_node **nd, t_type *tp, char *message, int (*fc)())
return 1; return 1;
} }
int ChkAssCompat(t_node **nd, t_type *tp, char *message) int ChkAssCompat(struct node **nd, struct type *tp, char *message)
{ {
/* Check assignment compatibility of node "nd" with type "tp". /* Check assignment compatibility of node "nd" with type "tp".
Give an error message when it fails Give an error message when it fails
@ -281,7 +281,7 @@ int ChkAssCompat(t_node **nd, t_type *tp, char *message)
return CompatCheck(nd, tp, message, TstAssCompat); return CompatCheck(nd, tp, message, TstAssCompat);
} }
int ChkCompat(t_node **nd, t_type *tp, char *message) int ChkCompat(struct node **nd, struct type *tp, char *message)
{ {
/* Check compatibility of node "nd" with type "tp". /* Check compatibility of node "nd" with type "tp".
Give an error message when it fails Give an error message when it fails

21
lang/m2/comp/typequiv.h
View file

@ -8,18 +8,19 @@
#ifndef TYPEQUIV_H_ #ifndef TYPEQUIV_H_
#define TYPEQUIV_H_ #define TYPEQUIV_H_
typedef struct type t_type;
typedef struct node t_node;
typedef struct def t_def;
int TstProcEquiv(t_type *tp1, t_type *tp2); struct node;
int TstCompat(register t_type *tp1, register t_type *tp2); struct def;
int TstAssCompat(register t_type *tp1, register t_type *tp2); struct type;
int TstParCompat(int parno, register t_type *formaltype, int VARflag, t_node **nd, t_def *edf);
int ChkCompat(t_node **nd, t_type *tp, char *message); int TstProcEquiv(struct type *tp1, struct type *tp2);
int ChkAssCompat(t_node **nd, t_type *tp, char *message); int TstCompat(register struct type *tp1, register struct type *tp2);
int TstAssCompat(register struct type *tp1, register struct type *tp2);
int TstParCompat(int parno, register struct type *formaltype, int VARflag, struct node **nd, struct def *edf);
char *incompat(register t_type *tp1, register t_type *tp2); int ChkCompat(struct node **nd, struct type *tp, char *message);
int ChkAssCompat(struct node **nd, struct type *tp, char *message);
char *incompat(register struct type *tp1, register struct type *tp2);
#endif /* TYPEQUIV_H_ */ #endif /* TYPEQUIV_H_ */

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

@ -47,7 +47,7 @@
#include "code.h" #include "code.h"
#include "warning.h" #include "warning.h"
int CaseCode(t_node *, label, int); int CaseCode(struct node *, label, int);
extern int proclevel; extern int proclevel;
extern int gdb_flag; extern int gdb_flag;
@ -55,10 +55,10 @@ extern int gdb_flag;
label text_label; label text_label;
label data_label = 1; label data_label = 1;
struct withdesig* WithDesigs; struct withdesig* WithDesigs;
t_node* Modules; struct node* Modules;
static t_type* func_type; static struct type* func_type;
static t_node* priority; static struct node* priority;
static int oldlineno; static int oldlineno;
@ -71,17 +71,17 @@ static int oldlineno;
#define EXIT_FLAG 2 #define EXIT_FLAG 2
/* Forward declarations. */ /* Forward declarations. */
static void WalkDef(register t_def*); static void WalkDef(register struct def*);
static void MkCalls(register t_def*); static void MkCalls(register struct def*);
static void UseWarnings(register t_def*); static void UseWarnings(register struct def*);
static void RegisterMessage(register t_def*); static void RegisterMessage(register struct def*);
static void WalkDefList(register t_def*, void (*proc)(t_def*)); static void WalkDefList(register struct def*, void (*proc)(struct def*));
#ifdef DBSYMTAB #ifdef DBSYMTAB
static void stabdef(t_def*); static void stabdef(struct def*);
#endif #endif
int LblWalkNode(label lbl, t_node *nd, int exit, int reach) int LblWalkNode(label lbl, struct node *nd, int exit, int reach)
{ {
/* Generate code for node "nd", after generating instruction /* Generate code for node "nd", after generating instruction
label "lbl". "exit" is the exit label for the closest label "lbl". "exit" is the exit label for the closest
@ -127,7 +127,7 @@ void def_ilb(label l)
oldlineno = 0; oldlineno = 0;
} }
void DoLineno(register t_node* nd) void DoLineno(register struct node* nd)
{ {
if ((!options['L'] if ((!options['L']
#ifdef DBSYMTAB #ifdef DBSYMTAB
@ -173,10 +173,10 @@ void DoFilename(int needed)
} }
} }
void WalkModule(register t_def* module) void WalkModule(register struct def* module)
{ {
register t_scope* sc; register struct scope* sc;
t_scopelist* savevis = CurrVis; struct scopelist* savevis = CurrVis;
CurrVis = module->mod_vis; CurrVis = module->mod_vis;
priority = module->mod_priority; priority = module->mod_priority;
@ -216,7 +216,7 @@ void WalkModule(register t_def* module)
Call initialization routines of imported modules. Call initialization routines of imported modules.
Also prevent recursive calls of this one. Also prevent recursive calls of this one.
*/ */
register t_node* nd = Modules; register struct node* nd = Modules;
if (state == IMPLEMENTATION) if (state == IMPLEMENTATION)
{ {
@ -273,13 +273,13 @@ void WalkModule(register t_def* module)
WalkDefList(sc->sc_def, UseWarnings); WalkDefList(sc->sc_def, UseWarnings);
} }
void WalkProcedure(register t_def* procedure) void WalkProcedure(register struct def* procedure)
{ {
t_scopelist* savevis = CurrVis; struct scopelist* savevis = CurrVis;
register t_type* tp; register struct type* tp;
register t_param* param; register struct paramlist* param;
register t_scope* procscope = procedure->prc_vis->sc_scope; register struct scope* procscope = procedure->prc_vis->sc_scope;
label too_big = 0; /* returnsize larger than returnarea */ label too_big = 0; /* returnsize larger than returnarea */
arith StackAdjustment = 0; /* space for conformant arrays */ arith StackAdjustment = 0; /* space for conformant arrays */
arith retsav = 0; /* temporary space for return value */ arith retsav = 0; /* temporary space for return value */
@ -562,7 +562,7 @@ void WalkProcedure(register t_def* procedure)
} }
/* Walk through a list of definitions */ /* Walk through a list of definitions */
static void WalkDef(register t_def* df) static void WalkDef(register struct def* df)
{ {
@ -590,7 +590,7 @@ static void WalkDef(register t_def* df)
} }
/* Generate calls to initialization routines of modules */ /* Generate calls to initialization routines of modules */
static void MkCalls(register t_def* df) static void MkCalls(register struct def* df)
{ {
@ -601,7 +601,7 @@ static void MkCalls(register t_def* df)
} }
} }
int WalkLink(register t_node* nd, label exit_label, int end_reached) int WalkLink(register struct node* nd, label exit_label, int end_reached)
{ {
while (nd && nd->nd_class == Link) while (nd && nd->nd_class == Link)
@ -613,19 +613,19 @@ int WalkLink(register t_node* nd, label exit_label, int end_reached)
return WalkNode(nd, exit_label, end_reached); return WalkNode(nd, exit_label, end_reached);
} }
static void ForLoopVarExpr(register t_node* nd) static void ForLoopVarExpr(register struct node* nd)
{ {
register t_type* tp = nd->nd_type; register struct type* tp = nd->nd_type;
CodePExpr(nd); CodePExpr(nd);
CodeCoercion(tp, BaseType(tp)); CodeCoercion(tp, BaseType(tp));
} }
int WalkStat(register t_node* nd, label exit_label, int end_reached) int WalkStat(register struct node* nd, label exit_label, int end_reached)
{ {
register t_node* left = nd->nd_LEFT; register struct node* left = nd->nd_LEFT;
register t_node* right = nd->nd_RIGHT; register struct node* right = nd->nd_RIGHT;
assert(nd->nd_class == Stat); assert(nd->nd_class == Stat);
@ -647,7 +647,7 @@ int WalkStat(register t_node* nd, label exit_label, int end_reached)
{ {
case '(': case '(':
{ {
t_node* nd1 = nd; struct node* nd1 = nd;
if (ChkCall(&nd1)) if (ChkCall(&nd1))
{ {
assert(nd == nd1); assert(nd == nd1);
@ -741,8 +741,8 @@ int WalkStat(register t_node* nd, label exit_label, int end_reached)
label l2 = ++text_label; label l2 = ++text_label;
int uns = 0; int uns = 0;
arith stepsize; arith stepsize;
t_type* bstp; struct type* bstp;
t_node* loopid; struct node* loopid;
good_forvar = DoForInit(left); good_forvar = DoForInit(left);
loopid = left->nd_LEFT; loopid = left->nd_LEFT;
@ -840,9 +840,9 @@ int WalkStat(register t_node* nd, label exit_label, int end_reached)
case WITH: case WITH:
{ {
t_scopelist link; struct scopelist link;
struct withdesig wds; struct withdesig wds;
t_desig ds; struct desig ds;
if (!WalkDesignator(&(nd->nd_LEFT), &ds, D_USED)) if (!WalkDesignator(&(nd->nd_LEFT), &ds, D_USED))
break; break;
@ -918,7 +918,7 @@ int WalkStat(register t_node* nd, label exit_label, int end_reached)
} }
int (*WalkTable[])(t_node*, label, int) = { int (*WalkTable[])(struct node*, label, int) = {
NodeCrash, NodeCrash,
NodeCrash, NodeCrash,
NodeCrash, NodeCrash,
@ -934,12 +934,12 @@ int (*WalkTable[])(t_node*, label, int) = {
WalkLink, WalkLink,
}; };
extern t_desig null_desig; extern struct desig null_desig;
void ExpectBool(register t_node** pnd, label true_label, label false_label) void ExpectBool(register struct node** pnd, label true_label, label false_label)
{ {
t_desig ds; struct desig ds;
ds = null_desig; ds = null_desig;
if (ChkExpression(pnd)) if (ChkExpression(pnd))
@ -953,7 +953,7 @@ void ExpectBool(register t_node** pnd, label true_label, label false_label)
} }
} }
int WalkDesignator(t_node** pnd, t_desig* ds, int flags) int WalkDesignator(struct node** pnd, struct desig* ds, int flags)
{ {
if (!ChkVariable(pnd, flags)) if (!ChkVariable(pnd, flags))
@ -964,12 +964,12 @@ int WalkDesignator(t_node** pnd, t_desig* ds, int flags)
return 1; return 1;
} }
int DoForInit(t_node* nd) int DoForInit(struct node* nd)
{ {
register t_node* right = nd->nd_RIGHT; register struct node* right = nd->nd_RIGHT;
register t_def* df; register struct def* df;
t_type* base_tp; struct type* base_tp;
t_type *tpl, *tpr; struct type *tpl, *tpr;
int r; int r;
r = ChkVariable(&(nd->nd_LEFT), D_USED | D_DEFINED); r = ChkVariable(&(nd->nd_LEFT), D_USED | D_DEFINED);
@ -994,7 +994,7 @@ int DoForInit(t_node* nd)
if (df->df_scope != CurrentScope) if (df->df_scope != CurrentScope)
{ {
register t_scopelist* sc = CurrVis; register struct scopelist* sc = CurrVis;
for (;;) for (;;)
{ {
@ -1042,15 +1042,15 @@ int DoForInit(t_node* nd)
} }
void DoAssign(register t_node* nd) void DoAssign(register struct node* nd)
{ {
/* May we do it in this order (expression first) ??? /* May we do it in this order (expression first) ???
The reference manual sais nothing about it, but the book does: The reference manual sais nothing about it, but the book does:
it sais that the left hand side is evaluated first. it sais that the left hand side is evaluated first.
DAMN THE BOOK! DAMN THE BOOK!
*/ */
t_desig dsr; struct desig dsr;
register t_type* tp; register struct type* tp;
if (!(ChkExpression(&(nd->nd_RIGHT)) & ChkVariable(&(nd->nd_LEFT), D_DEFINED))) if (!(ChkExpression(&(nd->nd_RIGHT)) & ChkVariable(&(nd->nd_LEFT), D_DEFINED)))
return; return;
@ -1078,9 +1078,9 @@ void DoAssign(register t_node* nd)
CodeMove(&dsr, nd->nd_LEFT, tp); CodeMove(&dsr, nd->nd_LEFT, tp);
} }
static void RegisterMessage(register t_def* df) static void RegisterMessage(register struct def* df)
{ {
register t_type* tp; register struct type* tp;
if (df->df_kind == D_VARIABLE) if (df->df_kind == D_VARIABLE)
{ {
@ -1107,7 +1107,7 @@ static void RegisterMessage(register t_def* df)
} }
} }
static void df_warning(t_node* nd, t_def* df, char* warning) static void df_warning(struct node* nd, struct def* df, char* warning)
{ {
if (!(df->df_kind & (D_VARIABLE | D_PROCEDURE | D_TYPE | D_CONST | D_PROCHEAD))) if (!(df->df_kind & (D_VARIABLE | D_PROCEDURE | D_TYPE | D_CONST | D_PROCHEAD)))
{ {
@ -1123,9 +1123,9 @@ static void df_warning(t_node* nd, t_def* df, char* warning)
} }
} }
static void UseWarnings(register t_def* df) static void UseWarnings(register struct def* df)
{ {
t_node* nd = df->df_scope->sc_end; struct node* nd = df->df_scope->sc_end;
if (is_anon_idf(df->df_idf) || !(df->df_kind & (D_IMPORTED | D_VARIABLE | D_PROCEDURE | D_CONST | D_TYPE)) || (df->df_flags & (D_EXPORTED | D_QEXPORTED))) if (is_anon_idf(df->df_idf) || !(df->df_kind & (D_IMPORTED | D_VARIABLE | D_PROCEDURE | D_CONST | D_TYPE)) || (df->df_flags & (D_EXPORTED | D_QEXPORTED)))
{ {
@ -1134,7 +1134,7 @@ static void UseWarnings(register t_def* df)
if (df->df_kind & D_IMPORTED) if (df->df_kind & D_IMPORTED)
{ {
register t_def* df1 = df->imp_def; register struct def* df1 = df->imp_def;
df1->df_flags |= df->df_flags & (D_USED | D_DEFINED); df1->df_flags |= df->df_flags & (D_USED | D_DEFINED);
if (df->df_kind == D_INUSE) if (df->df_kind == D_INUSE)
@ -1170,7 +1170,7 @@ static void UseWarnings(register t_def* df)
} }
} }
static void WalkDefList(register t_def* df, void (*proc)(t_def*)) static void WalkDefList(register struct def* df, void (*proc)(struct def*))
{ {
for (; df; df = df->df_nextinscope) for (; df; df = df->df_nextinscope)
{ {
@ -1179,7 +1179,7 @@ static void WalkDefList(register t_def* df, void (*proc)(t_def*))
} }
#ifdef DBSYMTAB #ifdef DBSYMTAB
static void stabdef(t_def* df) static void stabdef(struct def* df)
{ {
switch (df->df_kind) switch (df->df_kind)
{ {

28
lang/m2/comp/walk.h
View file

@ -11,13 +11,13 @@
#include "em_label.h" #include "em_label.h"
/* Forward type declarations. */ /* Forward type declarations. */
typedef struct node t_node; struct node;
typedef struct def t_def; struct def;
typedef struct desig t_desig; struct desig;
/* Definition of WalkNode macro /* Definition of WalkNode macro
*/ */
extern int (*WalkTable[])(t_node*, label, int); extern int (*WalkTable[])(struct node*, label, int);
#define WalkNode(xnd, xlab, rch) (*WalkTable[(unsigned int)((xnd)->nd_class)])((xnd), (xlab),(rch)) #define WalkNode(xnd, xlab, rch) (*WalkTable[(unsigned int)((xnd)->nd_class)])((xnd), (xlab),(rch))
@ -33,10 +33,10 @@ extern label data_label;
int LblWalkNode(label lbl, t_node *nd, int exit, int reach); int LblWalkNode(label lbl, struct node *nd, int exit, int reach);
void def_ilb(label l); void def_ilb(label l);
/* Generate line information as necessary for "nd". */ /* Generate line information as necessary for "nd". */
void DoLineno(register t_node* nd); void DoLineno(register struct node* nd);
/* Generate filename information, when needed. /* Generate filename information, when needed.
This routine is called at the generation of a This routine is called at the generation of a
procedure entry, and after generating a call to procedure entry, and after generating a call to
@ -49,27 +49,27 @@ void DoFilename(int needed);
Also generate code for its body. Also generate code for its body.
This code is collected in an initialization routine. This code is collected in an initialization routine.
*/ */
void WalkModule(register t_def* module); void WalkModule(register struct def* module);
/* Walk through the definition of a procedure and all its /* Walk through the definition of a procedure and all its
local definitions, checking and generating code. local definitions, checking and generating code.
*/ */
void WalkProcedure(register t_def* procedure); void WalkProcedure(register struct def* procedure);
/* Walk node "nd", which is a link. /* Walk node "nd", which is a link.
"exit_label" is set to a label number when inside a LOOP. "exit_label" is set to a label number when inside a LOOP.
"end_reached" maintains info about reachability (REACH_FLAG), "end_reached" maintains info about reachability (REACH_FLAG),
and whether an EXIT statement was seen (EXIT_FLAG). and whether an EXIT statement was seen (EXIT_FLAG).
*/ */
int WalkLink(register t_node* nd, label exit_label, int end_reached); int WalkLink(register struct node* nd, label exit_label, int end_reached);
/* Walk through a statement node "nd", generating code for it. */ /* Walk through a statement node "nd", generating code for it. */
int WalkStat(register t_node* nd, label exit_label, int end_reached); int WalkStat(register struct node* nd, label exit_label, int end_reached);
/* Generate code to evaluate a boolean expression "pnd" */ /* Generate code to evaluate a boolean expression "pnd" */
void ExpectBool(register t_node** pnd, label true_label, label false_label); void ExpectBool(register struct node** pnd, label true_label, label false_label);
/* Check designator and generate code for it */ /* Check designator and generate code for it */
int WalkDesignator(t_node** pnd, t_desig* ds, int flags); int WalkDesignator(struct node** pnd, struct desig* ds, int flags);
void DoAssign(register t_node* nd); void DoAssign(register struct node* nd);
int DoForInit(t_node* nd); int DoForInit(struct node* nd);
#endif /* WALK_H_ */ #endif /* WALK_H_ */