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

Minor adaptions in order to reduce the size

Browse source
This commit is contained in:
ceriel 1987-09-23 16:39:43 +00:00
parent 1eda133f01
commit fd817d4dbc
34 changed files with 790 additions and 746 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -32,9 +32,9 @@
long str2long(); long str2long();
struct token dot, t_token dot,
aside; aside;
struct type *toktype; t_type *toktype;
int idfsize = IDFSIZE; int idfsize = IDFSIZE;
int ForeignFlag; int ForeignFlag;
#ifdef DEBUG #ifdef DEBUG
@ -236,7 +236,7 @@ LLlex()
/* LLlex() is the Lexical Analyzer. /* LLlex() is the Lexical Analyzer.
The putting aside of tokens is taken into account. The putting aside of tokens is taken into account.
*/ */
register struct token *tk = ˙ register t_token *tk = ˙
char buf[(IDFSIZE > NUMSIZE ? IDFSIZE : NUMSIZE) + 2]; char buf[(IDFSIZE > NUMSIZE ? IDFSIZE : NUMSIZE) + 2];
register int ch, nch; register int ch, nch;
@ -339,7 +339,7 @@ again:
case STIDF: case STIDF:
{ {
register char *tag = &buf[0]; register char *tag = &buf[0];
register struct idf *id; register t_idf *id;
do { do {
if (tag - buf < idfsize) *tag++ = ch; if (tag - buf < idfsize) *tag++ = ch;

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

@ -32,13 +32,15 @@ struct token {
} tk_data; } tk_data;
}; };
typedef struct token t_token;
#define TOK_IDF tk_data.tk_idf #define TOK_IDF tk_data.tk_idf
#define TOK_STR tk_data.tk_str->s_str #define TOK_STR tk_data.tk_str->s_str
#define TOK_SLE tk_data.tk_str->s_length #define TOK_SLE tk_data.tk_str->s_length
#define TOK_INT tk_data.tk_int #define TOK_INT tk_data.tk_int
#define TOK_REL tk_data.tk_real #define TOK_REL tk_data.tk_real
extern struct token dot, aside; extern t_token dot, aside;
extern struct type *toktype; extern struct type *toktype;
#define DOT dot.tk_symb #define DOT dot.tk_symb

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

@ -24,7 +24,7 @@
#include "Lpars.h" #include "Lpars.h"
extern char *symbol2str(); extern char *symbol2str();
extern struct idf *gen_anon_idf(); extern t_idf *gen_anon_idf();
LLmessage(tk) LLmessage(tk)
register int tk; register int tk;
@ -32,7 +32,7 @@ LLmessage(tk)
if (tk > 0) { if (tk > 0) {
/* if (tk > 0), it represents the token to be inserted. /* if (tk > 0), it represents the token to be inserted.
*/ */
register struct token *dotp = &dot; register t_token *dotp = &dot;
error("%s missing", symbol2str(tk)); error("%s missing", symbol2str(tk));

2
lang/m2/comp/Makefile
View file

@ -39,7 +39,7 @@ OBJ = $(COBJ) $(LOBJ) Lpars.o
GENH= errout.h\ GENH= errout.h\
idfsize.h numsize.h strsize.h target_sizes.h \ idfsize.h numsize.h strsize.h target_sizes.h \
inputtype.h maxset.h density.h\ inputtype.h maxset.h density.h squeeze.h \
def.h debugcst.h type.h Lpars.h node.h desig.h def.h debugcst.h type.h Lpars.h node.h desig.h
HFILES= LLlex.h\ HFILES= LLlex.h\
chk_expr.h class.h const.h debug.h f_info.h idf.h\ chk_expr.h class.h const.h debug.h f_info.h idf.h\

6
lang/m2/comp/Parameters
View file

@ -59,3 +59,9 @@
!File: density.h !File: density.h
#define DENSITY 3 /* see casestat.C for an explanation */ #define DENSITY 3 /* see casestat.C for an explanation */
!File: squeeze.h
#undef SQUEEZE 1 /* define on "small" machines */

23
lang/m2/comp/casestat.C
View file

@ -24,6 +24,7 @@
#include <alloc.h> #include <alloc.h>
#include <assert.h> #include <assert.h>
#include "squeeze.h"
#include "Lpars.h" #include "Lpars.h"
#include "type.h" #include "type.h"
#include "LLlex.h" #include "LLlex.h"
@ -38,7 +39,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 */
struct type *sh_type; /* type of case expression */ t_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
@ -65,7 +66,7 @@ struct case_entry {
#define compact(nr, low, up) (nr != 0 && (up - low) / nr <= DENSITY) #define compact(nr, low, up) (nr != 0 && (up - low) / nr <= DENSITY)
CaseCode(nd, exitlabel) CaseCode(nd, exitlabel)
struct node *nd; t_node *nd;
label exitlabel; label exitlabel;
{ {
/* Check the expression, stack a new case header and /* Check the expression, stack a new case header and
@ -74,7 +75,7 @@ CaseCode(nd, exitlabel)
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 struct node *pnode = nd; register t_node *pnode = nd;
register struct case_entry *ce; register struct case_entry *ce;
register arith val; register arith val;
label CaseDescrLab; label CaseDescrLab;
@ -151,7 +152,7 @@ CaseCode(nd, exitlabel)
else if (sh->sh_default) C_rom_ilb(sh->sh_default); else if (sh->sh_default) C_rom_ilb(sh->sh_default);
else C_rom_ucon("0", pointer_size); else C_rom_ucon("0", pointer_size);
} }
C_lae_dlb(CaseDescrLab, (arith)0); /* perform the switch */ c_lae_dlb(CaseDescrLab); /* perform the switch */
C_csa(word_size); C_csa(word_size);
} }
else { else {
@ -164,7 +165,7 @@ CaseCode(nd, exitlabel)
C_rom_cst(ce->ce_value); C_rom_cst(ce->ce_value);
C_rom_ilb(ce->ce_label); C_rom_ilb(ce->ce_label);
} }
C_lae_dlb(CaseDescrLab, (arith)0); /* perform the switch */ c_lae_dlb(CaseDescrLab); /* perform the switch */
C_csb(word_size); C_csb(word_size);
} }
@ -174,8 +175,9 @@ CaseCode(nd, exitlabel)
while (pnode = pnode->nd_right) { while (pnode = pnode->nd_right) {
if (pnode->nd_class == Link && pnode->nd_symb == '|') { if (pnode->nd_class == Link && pnode->nd_symb == '|') {
if (pnode->nd_left) { if (pnode->nd_left) {
C_df_ilb(pnode->nd_lab); LblWalkNode(pnode->nd_lab,
WalkNode(pnode->nd_left->nd_right, exitlabel); pnode->nd_left->nd_right,
exitlabel);
C_bra(sh->sh_break); C_bra(sh->sh_break);
} }
} }
@ -184,8 +186,7 @@ CaseCode(nd, exitlabel)
*/ */
assert(sh->sh_default != 0); assert(sh->sh_default != 0);
C_df_ilb(sh->sh_default); LblWalkNode(sh->sh_default, pnode, exitlabel);
WalkNode(pnode, exitlabel);
break; break;
} }
} }
@ -214,7 +215,7 @@ FreeSh(sh)
AddCases(sh, node, lbl) AddCases(sh, node, lbl)
struct switch_hdr *sh; struct switch_hdr *sh;
register struct node *node; register t_node *node;
label lbl; label lbl;
{ {
/* Add case labels to the case label list /* Add case labels to the case label list
@ -246,7 +247,7 @@ AddCases(sh, node, lbl)
AddOneCase(sh, node, lbl) AddOneCase(sh, node, lbl)
register struct switch_hdr *sh; register struct switch_hdr *sh;
struct node *node; t_node *node;
label lbl; label lbl;
{ {
register struct case_entry *ce = new_case_entry(); register struct case_entry *ce = new_case_entry();

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

@ -36,34 +36,37 @@ extern char *symbol2str();
extern char *sprint(); extern char *sprint();
STATIC int STATIC int
Xerror(nd, mess, edf) df_error(nd, mess, edf)
struct node *nd; t_node *nd; /* node on which error occurred */
char *mess; char *mess; /* error message */
register struct def *edf; register t_def *edf; /* do we have a name? */
{ {
if (edf) { if (edf) {
if (edf->df_kind != D_ERROR) { if (edf->df_kind != D_ERROR) {
node_error(nd,"\"%s\": %s", edf->df_idf->id_text, mess); node_error(nd,"\"%s\": %s", edf->df_idf->id_text, mess);
} }
} }
else node_error(nd, "%s", mess); else node_error(nd, mess);
return 0; return 0;
} }
MkCoercion(pnd, tp) MkCoercion(pnd, tp)
struct node **pnd; t_node **pnd;
register struct type *tp; register t_type *tp;
{ {
register struct node *nd = *pnd; /* Make a coercion from the node indicated by *pnd to the
register struct type *nd_tp = nd->nd_type; type indicated by tp.
extern int pass_1; */
int w = 0; register t_node *nd = *pnd;
register t_type *nd_tp = nd->nd_type;
extern int pass_1;
int w = 0;
if (nd_tp == tp) return; if (nd_tp == tp || nd_tp->tp_fund == T_STRING /* Why ??? */) return;
if (nd_tp->tp_fund == T_STRING) return;
nd_tp = BaseType(nd_tp); nd_tp = BaseType(nd_tp);
if (nd->nd_class == Value && if (nd->nd_class == Value &&
(nd_tp->tp_fund != T_REAL && tp->tp_fund != T_REAL)) { nd_tp->tp_fund != T_REAL &&
tp->tp_fund != T_REAL) {
switch(tp->tp_fund) { switch(tp->tp_fund) {
case T_SUBRANGE: case T_SUBRANGE:
if (! chk_bounds(tp->sub_lb, nd->nd_INT, if (! chk_bounds(tp->sub_lb, nd->nd_INT,
@ -123,7 +126,7 @@ MkCoercion(pnd, tp)
int int
ChkVariable(expp) ChkVariable(expp)
register struct node *expp; register t_node *expp;
{ {
/* Check that "expp" indicates an item that can be /* Check that "expp" indicates an item that can be
assigned to. assigned to.
@ -132,17 +135,17 @@ ChkVariable(expp)
return ChkDesignator(expp) && return ChkDesignator(expp) &&
( expp->nd_class != Def || ( expp->nd_class != Def ||
( expp->nd_def->df_kind & (D_FIELD|D_VARIABLE)) || ( expp->nd_def->df_kind & (D_FIELD|D_VARIABLE)) ||
Xerror(expp, "variable expected", expp->nd_def)); df_error(expp, "variable expected", expp->nd_def));
} }
STATIC int STATIC int
ChkArrow(expp) ChkArrow(expp)
register struct node *expp; register t_node *expp;
{ {
/* 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 struct type *tp; register t_type *tp;
assert(expp->nd_class == Arrow); assert(expp->nd_class == Arrow);
assert(expp->nd_symb == '^'); assert(expp->nd_symb == '^');
@ -164,7 +167,7 @@ ChkArrow(expp)
STATIC int STATIC int
ChkArr(expp) ChkArr(expp)
register struct node *expp; register t_node *expp;
{ {
/* 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,
@ -172,7 +175,7 @@ ChkArr(expp)
assignment compatible with the array-index. assignment compatible with the array-index.
*/ */
register struct type *tpl; register t_type *tpl;
assert(expp->nd_class == Arrsel); assert(expp->nd_class == Arrsel);
assert(expp->nd_symb == '['); assert(expp->nd_symb == '[');
@ -180,6 +183,8 @@ ChkArr(expp)
expp->nd_type = error_type; expp->nd_type = error_type;
if (! (ChkVariable(expp->nd_left) & ChkExpression(expp->nd_right))) { if (! (ChkVariable(expp->nd_left) & ChkExpression(expp->nd_right))) {
/* Bitwise and, because we want them both evaluated.
*/
return 0; return 0;
} }
@ -204,7 +209,7 @@ ChkArr(expp)
#ifdef DEBUG #ifdef DEBUG
STATIC int STATIC int
ChkValue(expp) ChkValue(expp)
struct node *expp; t_node *expp;
{ {
switch(expp->nd_symb) { switch(expp->nd_symb) {
case REAL: case REAL:
@ -221,12 +226,12 @@ ChkValue(expp)
STATIC int STATIC int
ChkLinkOrName(expp) ChkLinkOrName(expp)
register struct node *expp; register t_node *expp;
{ {
/* 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 struct def *df; register t_def *df;
expp->nd_type = error_type; expp->nd_type = error_type;
@ -239,7 +244,7 @@ ChkLinkOrName(expp)
/* 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 struct node *left = expp->nd_left; register t_node *left = expp->nd_left;
assert(expp->nd_symb == '.'); assert(expp->nd_symb == '.');
@ -250,7 +255,7 @@ ChkLinkOrName(expp)
!(left->nd_def->df_kind & (D_MODULE|D_VARIABLE|D_FIELD)) !(left->nd_def->df_kind & (D_MODULE|D_VARIABLE|D_FIELD))
) )
) { ) {
return Xerror(left, "illegal selection", left->nd_def); return df_error(left, "illegal selection", left->nd_def);
} }
if (left->nd_type->tp_fund != T_RECORD) { if (left->nd_type->tp_fund != T_RECORD) {
node_error(left, "illegal selection"); node_error(left, "illegal selection");
@ -268,7 +273,9 @@ ChkLinkOrName(expp)
/* Fields of a record are always D_QEXPORTED, /* Fields of a record are always D_QEXPORTED,
so ... so ...
*/ */
Xerror(expp, "not exported from qualifying module", df); df_error(expp,
"not exported from qualifying module",
df);
} }
if (!(left->nd_class == Def && if (!(left->nd_class == Def &&
@ -286,12 +293,12 @@ Xerror(expp, "not exported from qualifying module", df);
STATIC int STATIC int
ChkExLinkOrName(expp) ChkExLinkOrName(expp)
register struct node *expp; register t_node *expp;
{ {
/* 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 struct def *df; register t_def *df;
if (! ChkLinkOrName(expp)) return 0; if (! ChkLinkOrName(expp)) return 0;
@ -302,6 +309,7 @@ ChkExLinkOrName(expp)
*/ */
if (df->df_type->tp_fund == T_SET) { if (df->df_type->tp_fund == T_SET) {
expp->nd_class = Set; expp->nd_class = Set;
inc_refcount(expp->nd_set);
} }
else expp->nd_class = Value; else expp->nd_class = Value;
if (df->df_kind == D_ENUM) { if (df->df_kind == D_ENUM) {
@ -314,23 +322,11 @@ ChkExLinkOrName(expp)
assert(df->df_kind == D_CONST); assert(df->df_kind == D_CONST);
expp->nd_token = df->con_const; expp->nd_token = df->con_const;
expp->nd_lineno = ln; expp->nd_lineno = ln;
if (expp->nd_class == Set) {
register int i =
(unsigned) expp->nd_type->tp_size /
(unsigned) word_size;
register arith *p, *q;
p = expp->nd_set;
q = (arith *) Malloc((unsigned) i * sizeof(arith));
expp->nd_set = q;
while (i--) *q++ = *p++;
}
} }
} }
if (!(df->df_kind & D_VALUE)) { if (!(df->df_kind & D_VALUE)) {
Xerror(expp, "value expected", df); return df_error(expp, "value expected", df);
return 0;
} }
if (df->df_kind == D_PROCEDURE) { if (df->df_kind == D_PROCEDURE) {
@ -341,7 +337,8 @@ ChkExLinkOrName(expp)
/* Address of standard or nested procedure /* Address of standard or nested procedure
taken. taken.
*/ */
node_error(expp, "standard or local procedures may not be assigned"); node_error(expp,
"standard or local procedures may not be assigned");
return 0; return 0;
} }
} }
@ -351,8 +348,8 @@ node_error(expp, "standard or local procedures may not be assigned");
STATIC int STATIC int
ChkEl(expr, tp) ChkEl(expr, tp)
register struct node **expr; register t_node **expr;
struct type *tp; t_type *tp;
{ {
return ChkExpression(*expr) && ChkCompat(expr, tp, "set element"); return ChkExpression(*expr) && ChkCompat(expr, tp, "set element");
@ -360,15 +357,15 @@ ChkEl(expr, tp)
STATIC int STATIC int
ChkElement(expp, tp, set) ChkElement(expp, tp, set)
struct node **expp; t_node **expp;
struct type *tp; t_type *tp;
arith *set; 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 struct node *expr = *expp; register t_node *expr = *expp;
register unsigned int i; register unsigned int i;
arith lo, hi, low, high; arith lo, hi, low, high;
@ -419,17 +416,38 @@ ChkElement(expp, tp, set)
return 1; return 1;
} }
arith *
MkSet(size)
unsigned size;
{
register arith *s;
size += sizeof(arith);
s = (arith *) Malloc(size);
clear((char *) s , size);
s++;
inc_refcount(s);
return s;
}
FreeSet(s)
register arith *s;
{
if (refcount(s) <= 0) {
free((char *) (s-1));
}
}
STATIC int STATIC int
ChkSet(expp) ChkSet(expp)
register struct node *expp; register t_node *expp;
{ {
/* 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 struct type *tp; register t_type *tp;
register struct node *nd; register t_node *nd;
register struct def *df; register t_def *df;
unsigned size;
int retval = 1; int retval = 1;
int SetIsConstant = 1; int SetIsConstant = 1;
@ -449,10 +467,7 @@ ChkSet(expp)
if (!is_type(df) || if (!is_type(df) ||
(df->df_type->tp_fund != T_SET)) { (df->df_type->tp_fund != T_SET)) {
if (df->df_kind != D_ERROR) { return df_error(nd, "not a SET type", df);
Xerror(nd, "not a SET type", df);
}
return 0;
} }
tp = df->df_type; tp = df->df_type;
FreeNode(nd); FreeNode(nd);
@ -466,9 +481,8 @@ ChkSet(expp)
/* Now check the elements given, and try to compute a constant set. /* Now check the elements given, and try to compute a constant set.
First allocate room for the set. First allocate room for the set.
*/ */
size = tp->tp_size * (sizeof(arith) / word_size);
expp->nd_set = (arith *) Malloc(size); expp->nd_set = MkSet((unsigned)(tp->tp_size) * (sizeof(arith) / (int) word_size));
clear((char *) (expp->nd_set) , size);
/* Now check the elements, one by one /* Now check the elements, one by one
*/ */
@ -490,25 +504,26 @@ ChkSet(expp)
return retval; return retval;
} }
STATIC struct node * STATIC t_node *
nextarg(argp, edf) nextarg(argp, edf)
struct node **argp; t_node **argp;
struct def *edf; t_def *edf;
{ {
register struct node *arg = (*argp)->nd_right; register t_node *arg = (*argp)->nd_right;
if (! arg) { if (! arg) {
return (struct node *)Xerror(*argp, "too few arguments supplied", edf); return (t_node *)
df_error(*argp, "too few arguments supplied", edf);
} }
*argp = arg; *argp = arg;
return arg->nd_left; return arg->nd_left;
} }
STATIC struct node * STATIC t_node *
getarg(argp, bases, designator, edf) getarg(argp, bases, designator, edf)
struct node **argp; t_node **argp;
struct def *edf; t_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".
@ -518,9 +533,10 @@ getarg(argp, bases, designator, 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 struct node *left = nextarg(argp, edf); register t_node *left = nextarg(argp, edf);
if (!left || (designator ? !ChkVariable(left) : !ChkExpression(left))) { if (! left ||
! (designator ? ChkVariable(left) : ChkExpression(left))) {
return 0; return 0;
} }
@ -529,38 +545,40 @@ getarg(argp, bases, designator, edf)
} }
if (bases) { if (bases) {
struct type *tp = BaseType(left->nd_type); t_type *tp = BaseType(left->nd_type);
MkCoercion(&((*argp)->nd_left), tp); if (! designator) MkCoercion(&((*argp)->nd_left), tp);
left = (*argp)->nd_left; left = (*argp)->nd_left;
if (!(tp->tp_fund & bases)) { if (!(tp->tp_fund & bases)) {
return (struct node *)Xerror(left, "unexpected parameter type", edf); return (t_node *)
df_error(left, "unexpected parameter type", edf);
} }
} }
return left; return left;
} }
STATIC struct node * STATIC t_node *
getname(argp, kinds, bases, edf) getname(argp, kinds, bases, edf)
struct node **argp; t_node **argp;
struct def *edf; t_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 struct node *left = nextarg(argp, edf); register t_node *left = nextarg(argp, edf);
if (!left || ! ChkDesignator(left)) return 0; if (!left || ! ChkDesignator(left)) return 0;
if (left->nd_class != Def) { if (left->nd_class != Def) {
return (struct node *)Xerror(left, "identifier expected", edf); return (t_node *)df_error(left, "identifier expected", edf);
} }
if (!(left->nd_def->df_kind & kinds) || if (!(left->nd_def->df_kind & kinds) ||
(bases && !(left->nd_type->tp_fund & bases))) { (bases && !(left->nd_type->tp_fund & bases))) {
return (struct node *)Xerror(left, "unexpected parameter type", edf); return (t_node *)
df_error(left, "unexpected parameter type", edf);
} }
return left; return left;
@ -568,12 +586,12 @@ getname(argp, kinds, bases, edf)
STATIC int STATIC int
ChkProcCall(expp) ChkProcCall(expp)
struct node *expp; t_node *expp;
{ {
/* Check a procedure call /* Check a procedure call
*/ */
register struct node *left; register t_node *left;
struct def *edf = 0; t_def *edf = 0;
register struct paramlist *param; register struct paramlist *param;
int retval = 1; int retval = 1;
int cnt = 0; int cnt = 0;
@ -613,7 +631,7 @@ ChkProcCall(expp)
} }
if (expp->nd_right) { if (expp->nd_right) {
Xerror(expp->nd_right, "too many parameters supplied", edf); df_error(expp->nd_right, "too many parameters supplied", edf);
while (expp->nd_right) { while (expp->nd_right) {
getarg(&expp, 0, 0, edf); getarg(&expp, 0, 0, edf);
} }
@ -625,7 +643,7 @@ ChkProcCall(expp)
int int
ChkFunCall(expp) ChkFunCall(expp)
register struct node *expp; register t_node *expp;
{ {
/* Check a call that must have a result /* Check a call that must have a result
*/ */
@ -642,13 +660,13 @@ ChkFunCall(expp)
int int
ChkCall(expp) ChkCall(expp)
register struct node *expp; register t_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,
it may also be a cast or a standard procedure call. it may also be a cast or a standard procedure call.
*/ */
register struct node *left = expp->nd_left; register t_node *left = expp->nd_left;
STATIC int ChkStandard(); STATIC int ChkStandard();
STATIC int ChkCast(); STATIC int ChkCast();
@ -683,9 +701,9 @@ ChkCall(expp)
return ChkProcCall(expp); return ChkProcCall(expp);
} }
STATIC struct type * STATIC t_type *
ResultOfOperation(operator, tp) ResultOfOperation(operator, tp)
struct type *tp; t_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".
@ -744,7 +762,7 @@ AllowedTypes(operator)
STATIC int STATIC int
ChkAddress(tpl, tpr) ChkAddress(tpl, tpr)
register struct type *tpl, *tpr; register t_type *tpl, *tpr;
{ {
/* 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
@ -764,12 +782,12 @@ ChkAddress(tpl, tpr)
STATIC int STATIC int
ChkBinOper(expp) ChkBinOper(expp)
register struct node *expp; register t_node *expp;
{ {
/* Check a binary operation. /* Check a binary operation.
*/ */
register struct node *left, *right; register t_node *left, *right;
register struct type *tpl, *tpr; register t_type *tpl, *tpr;
int allowed; int allowed;
int retval; int retval;
@ -873,12 +891,12 @@ ChkBinOper(expp)
STATIC int STATIC int
ChkUnOper(expp) ChkUnOper(expp)
register struct node *expp; register t_node *expp;
{ {
/* Check an unary operation. /* Check an unary operation.
*/ */
register struct node *right = expp->nd_right; register t_node *right = expp->nd_right;
register struct type *tpr; register t_type *tpr;
if (expp->nd_symb == '(') { if (expp->nd_symb == '(') {
*expp = *right; *expp = *right;
@ -896,7 +914,9 @@ ChkUnOper(expp)
switch(expp->nd_symb) { switch(expp->nd_symb) {
case '+': case '+':
if (!(tpr->tp_fund & T_NUMERIC)) break; if (!(tpr->tp_fund & T_NUMERIC)) break;
/* fall through */ *expp = *right;
free_node(right);
return 1;
case '-': case '-':
if (tpr->tp_fund & T_INTORCARD) { if (tpr->tp_fund & T_INTORCARD) {
@ -935,15 +955,15 @@ ChkUnOper(expp)
return 0; return 0;
} }
STATIC struct node * STATIC t_node *
getvariable(argp, edf) getvariable(argp, edf)
struct node **argp; t_node **argp;
struct def *edf; t_def *edf;
{ {
/* 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 struct node *left = nextarg(argp, edf); register t_node *left = nextarg(argp, edf);
if (!left || !ChkVariable(left)) return 0; if (!left || !ChkVariable(left)) return 0;
@ -952,14 +972,14 @@ getvariable(argp, edf)
STATIC int STATIC int
ChkStandard(expp) ChkStandard(expp)
register struct node *expp; register t_node *expp;
{ {
/* Check a call of a standard procedure or function /* Check a call of a standard procedure or function
*/ */
struct node *arg = expp; t_node *arg = expp;
register struct node *left = expp->nd_left; register t_node *left = expp->nd_left;
register struct def *edf = left->nd_def; register t_def *edf = left->nd_def;
struct type *basetype; t_type *basetype;
int free_it = 0; int free_it = 0;
assert(left->nd_class == Def); assert(left->nd_class == Def);
@ -1010,8 +1030,8 @@ ChkStandard(expp)
case S_SHORT: case S_SHORT:
case S_LONG: { case S_LONG: {
struct type *tp; t_type *tp;
struct type *s1, *s2, *d1, *d2; t_type *s1, *s2, *d1, *d2;
if (edf->df_value.df_stdname == S_SHORT) { if (edf->df_value.df_stdname == S_SHORT) {
s1 = longint_type; s1 = longint_type;
@ -1037,7 +1057,7 @@ ChkStandard(expp)
MkCoercion(&(arg->nd_left), d2); MkCoercion(&(arg->nd_left), d2);
} }
else { else {
Xerror(left, "unexpected parameter type", edf); df_error(left, "unexpected parameter type", edf);
break; break;
} }
free_it = 1; free_it = 1;
@ -1056,7 +1076,7 @@ ChkStandard(expp)
break; break;
} }
if (left->nd_symb != STRING) { if (left->nd_symb != STRING) {
return Xerror(left,"array parameter expected", edf); return df_error(left,"array parameter expected", edf);
} }
expp->nd_type = card_type; expp->nd_type = card_type;
expp->nd_class = Value; expp->nd_class = Value;
@ -1105,12 +1125,12 @@ ChkStandard(expp)
expp->nd_type = 0; expp->nd_type = 0;
if (! (left = getvariable(&arg, edf))) return 0; if (! (left = getvariable(&arg, edf))) return 0;
if (! (left->nd_type->tp_fund == T_POINTER)) { if (! (left->nd_type->tp_fund == T_POINTER)) {
return Xerror(left, "pointer variable expected", edf); return df_error(left, "pointer variable expected", edf);
} }
/* Now, make it look like a call to ALLOCATE or DEALLOCATE */ /* Now, make it look like a call to ALLOCATE or DEALLOCATE */
{ {
struct token dt; t_token dt;
struct node *nd; t_node *nd;
dt.TOK_INT = PointedtoType(left->nd_type)->tp_size; dt.TOK_INT = PointedtoType(left->nd_type)->tp_size;
dt.tk_symb = INTEGER; dt.tk_symb = INTEGER;
@ -1121,9 +1141,9 @@ ChkStandard(expp)
arg->nd_right = MkNode(Link, nd, NULLNODE, &dt); arg->nd_right = MkNode(Link, nd, NULLNODE, &dt);
/* Ignore other arguments to NEW and/or DISPOSE ??? */ /* Ignore other arguments to NEW and/or DISPOSE ??? */
FreeNode(expp->nd_left);
dt.tk_symb = IDENT; dt.tk_symb = IDENT;
dt.tk_lineno = expp->nd_left->nd_lineno; dt.tk_lineno = expp->nd_left->nd_lineno;
FreeNode(expp->nd_left);
dt.TOK_IDF = str2idf(edf->df_value.df_stdname==S_NEW ? dt.TOK_IDF = str2idf(edf->df_value.df_stdname==S_NEW ?
"ALLOCATE" : "DEALLOCATE", 0); "ALLOCATE" : "DEALLOCATE", 0);
expp->nd_left = MkLeaf(Name, &dt); expp->nd_left = MkLeaf(Name, &dt);
@ -1178,7 +1198,7 @@ ChkStandard(expp)
expp->nd_type = 0; expp->nd_type = 0;
if (! (left = getvariable(&arg, edf))) return 0; if (! (left = getvariable(&arg, edf))) return 0;
if (! (left->nd_type->tp_fund & T_DISCRETE)) { if (! (left->nd_type->tp_fund & T_DISCRETE)) {
return Xerror(left,"illegal parameter type", edf); return df_error(left,"illegal parameter type", edf);
} }
if (arg->nd_right) { if (arg->nd_right) {
if (! getarg(&arg, T_INTORCARD, 0, edf)) return 0; if (! getarg(&arg, T_INTORCARD, 0, edf)) return 0;
@ -1192,14 +1212,14 @@ ChkStandard(expp)
case S_EXCL: case S_EXCL:
case S_INCL: case S_INCL:
{ {
register struct type *tp; register t_type *tp;
struct node *dummy; t_node *dummy;
expp->nd_type = 0; expp->nd_type = 0;
if (!(left = getvariable(&arg, edf))) return 0; if (!(left = getvariable(&arg, edf))) return 0;
tp = left->nd_type; tp = left->nd_type;
if (tp->tp_fund != T_SET) { if (tp->tp_fund != T_SET) {
return Xerror(arg, "SET parameter expected", edf); return df_error(arg, "SET parameter expected", edf);
} }
if (!(dummy = getarg(&arg, 0, 0, edf))) return 0; if (!(dummy = getarg(&arg, 0, 0, edf))) return 0;
if (!ChkAssCompat(&dummy, ElementType(tp), "EXCL/INCL")) { if (!ChkAssCompat(&dummy, ElementType(tp), "EXCL/INCL")) {
@ -1220,7 +1240,7 @@ ChkStandard(expp)
} }
if (arg->nd_right) { if (arg->nd_right) {
return Xerror(arg->nd_right, "too many parameters supplied", edf); return df_error(arg->nd_right, "too many parameters supplied", edf);
} }
if (free_it) { if (free_it) {
@ -1235,7 +1255,7 @@ ChkStandard(expp)
STATIC int STATIC int
ChkCast(expp) ChkCast(expp)
register struct node *expp; register t_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
@ -1244,12 +1264,12 @@ ChkCast(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 struct node *left = expp->nd_left; register t_node *left = expp->nd_left;
register struct node *arg = expp->nd_right; register t_node *arg = expp->nd_right;
register struct type *lefttype = left->nd_type; register t_type *lefttype = left->nd_type;
if ((! arg) || arg->nd_right) { if ((! arg) || arg->nd_right) {
return Xerror(expp, "type cast must have 1 parameter", left->nd_def); return df_error(expp, "type cast must have 1 parameter", left->nd_def);
} }
if (! ChkExpression(arg->nd_left)) return 0; if (! ChkExpression(arg->nd_left)) return 0;
@ -1260,7 +1280,7 @@ ChkCast(expp)
if (arg->nd_type->tp_size != lefttype->tp_size && if (arg->nd_type->tp_size != lefttype->tp_size &&
(arg->nd_type->tp_size > word_size || (arg->nd_type->tp_size > word_size ||
lefttype->tp_size > word_size)) { lefttype->tp_size > word_size)) {
Xerror(expp, "unequal sizes in type cast", left->nd_def); df_error(expp, "unequal sizes in type cast", left->nd_def);
} }
if (arg->nd_class == Value) { if (arg->nd_class == Value) {
@ -1275,8 +1295,8 @@ ChkCast(expp)
} }
TryToString(nd, tp) TryToString(nd, tp)
register struct node *nd; register t_node *nd;
struct type *tp; t_type *tp;
{ {
/* Try a coercion from character constant to string. /* Try a coercion from character constant to string.
*/ */
@ -1296,7 +1316,7 @@ TryToString(nd, tp)
STATIC int STATIC int
no_desig(expp) no_desig(expp)
struct node *expp; t_node *expp;
{ {
node_error(expp, "designator expected"); node_error(expp, "designator expected");
return 0; return 0;

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

@ -18,3 +18,6 @@ extern int (*DesigChkTable[])(); /* table of designator checking
#define ChkExpression(expp) ((*ExprChkTable[(expp)->nd_class])(expp)) #define ChkExpression(expp) ((*ExprChkTable[(expp)->nd_class])(expp))
#define ChkDesignator(expp) ((*DesigChkTable[(expp)->nd_class])(expp)) #define ChkDesignator(expp) ((*DesigChkTable[(expp)->nd_class])(expp))
#define inc_refcount(s) (*((s) - 1) += 1)
#define refcount(s) (*((s) - 1))

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

@ -21,6 +21,7 @@
#include <assert.h> #include <assert.h>
#include <alloc.h> #include <alloc.h>
#include "squeeze.h"
#include "type.h" #include "type.h"
#include "LLlex.h" #include "LLlex.h"
#include "def.h" #include "def.h"
@ -39,7 +40,7 @@ int fp_used;
STATIC char * STATIC char *
NameOfProc(df) NameOfProc(df)
register struct def *df; register t_def *df;
{ {
assert(df->df_kind & (D_PROCHEAD|D_PROCEDURE)); assert(df->df_kind & (D_PROCHEAD|D_PROCEDURE));
@ -68,14 +69,14 @@ CodeConst(cst, size)
/* /*
C_df_dlb(++data_label); C_df_dlb(++data_label);
C_rom_icon(long2str((long) cst), (arith) size); C_rom_icon(long2str((long) cst), (arith) size);
C_lae_dlb(data_label, (arith) 0); c_lae_dlb(data_label);
C_loi((arith) size); C_loi((arith) size);
*/ */
} }
} }
CodeString(nd) CodeString(nd)
register struct node *nd; register t_node *nd;
{ {
if (nd->nd_type->tp_fund != T_STRING) { if (nd->nd_type->tp_fund != T_STRING) {
/* Character constant */ /* Character constant */
@ -84,15 +85,15 @@ CodeString(nd)
} }
C_df_dlb(++data_label); C_df_dlb(++data_label);
C_rom_scon(nd->nd_STR, WA(nd->nd_SLE + 1)); C_rom_scon(nd->nd_STR, WA(nd->nd_SLE + 1));
C_lae_dlb(data_label, (arith) 0); c_lae_dlb(data_label);
} }
CodeExpr(nd, ds, true_label, false_label) CodeExpr(nd, ds, true_label, false_label)
register struct node *nd; register t_node *nd;
register struct desig *ds; register t_desig *ds;
label true_label, false_label; label true_label, false_label;
{ {
register struct type *tp = nd->nd_type; register t_type *tp = nd->nd_type;
if (tp->tp_fund == T_REAL) fp_used = 1; if (tp->tp_fund == T_REAL) fp_used = 1;
switch(nd->nd_class) { switch(nd->nd_class) {
@ -126,7 +127,7 @@ CodeExpr(nd, ds, true_label, false_label)
case REAL: case REAL:
C_df_dlb(++data_label); C_df_dlb(++data_label);
C_rom_fcon(nd->nd_REL, tp->tp_size); C_rom_fcon(nd->nd_REL, tp->tp_size);
C_lae_dlb(data_label, (arith) 0); c_lae_dlb(data_label);
C_loi(tp->tp_size); C_loi(tp->tp_size);
break; break;
case STRING: case STRING:
@ -154,8 +155,7 @@ CodeExpr(nd, ds, true_label, false_label)
for (; i; i--) { for (; i; i--) {
C_loc(*--st); C_loc(*--st);
} }
free((char *) nd->nd_set); FreeSet(nd->nd_set);
nd->nd_set = 0;
CodeSet(nd); CodeSet(nd);
} }
break; break;
@ -174,7 +174,7 @@ CodeExpr(nd, ds, true_label, false_label)
} }
CodeCoercion(t1, t2) CodeCoercion(t1, t2)
register struct type *t1, *t2; register t_type *t1, *t2;
{ {
register int fund1, fund2; register int fund1, fund2;
arith sz1 = t1->tp_size; arith sz1 = t1->tp_size;
@ -208,7 +208,7 @@ CodeCoercion(t1, t2)
case T_INTEGER: case T_INTEGER:
if (sz1 < word_size) { if (sz1 < word_size) {
C_loc(sz1); C_loc(sz1);
C_loc(word_size); c_loc((int) word_size);
C_cii(); C_cii();
} }
switch(fund2) { switch(fund2) {
@ -222,7 +222,7 @@ CodeCoercion(t1, t2)
case T_CARDINAL: case T_CARDINAL:
if (t1->tp_size != word_size) { if (t1->tp_size != word_size) {
C_loc(t1->tp_size); C_loc(t1->tp_size);
C_loc(word_size); c_loc((int) word_size);
C_ciu(); C_ciu();
} }
break; break;
@ -242,20 +242,20 @@ CodeCoercion(t1, t2)
case T_CARDINAL: case T_CARDINAL:
case T_INTORCARD: case T_INTORCARD:
if (t2->tp_size > word_size) { if (t2->tp_size > word_size) {
C_loc(word_size); c_loc((int) word_size);
C_loc(t2->tp_size); C_loc(t2->tp_size);
C_cuu(); C_cuu();
} }
break; break;
case T_INTEGER: case T_INTEGER:
if (fund1 == T_CARDINAL || t2->tp_size != word_size) { if (fund1 == T_CARDINAL || t2->tp_size != word_size) {
C_loc(word_size); c_loc((int) word_size);
C_loc(t2->tp_size); C_loc(t2->tp_size);
C_cui(); C_cui();
} }
break; break;
case T_REAL: case T_REAL:
C_loc(word_size); c_loc((int) word_size);
C_loc(t2->tp_size); C_loc(t2->tp_size);
C_cuf(); C_cuf();
break; break;
@ -286,7 +286,7 @@ CodeCoercion(t1, t2)
C_zrf(t1->tp_size); C_zrf(t1->tp_size);
C_cmf(t1->tp_size); C_cmf(t1->tp_size);
C_zge(lb); C_zge(lb);
C_loc((arith) ECONV); c_loc(ECONV);
C_trp(); C_trp();
C_df_ilb(lb); C_df_ilb(lb);
} }
@ -302,14 +302,14 @@ CodeCoercion(t1, t2)
} }
CodeCall(nd) CodeCall(nd)
register struct node *nd; register t_node *nd;
{ {
/* Generate code for a procedure call. Checking of parameters /* Generate code for a procedure call. Checking of parameters
and result is already done. and result is already done.
*/ */
register struct node *left = nd->nd_left; register t_node *left = nd->nd_left;
register struct node *right = nd->nd_right; register t_node *right = nd->nd_right;
register struct type *result_tp; register t_type *result_tp;
if (left->nd_type == std_type) { if (left->nd_type == std_type) {
CodeStd(nd); CodeStd(nd);
@ -360,11 +360,11 @@ CodeCall(nd)
CodeParameters(param, arg) CodeParameters(param, arg)
struct paramlist *param; struct paramlist *param;
struct node *arg; t_node *arg;
{ {
register struct type *tp; register t_type *tp;
register struct node *left; register t_node *left;
register struct type *left_type; register t_type *left_type;
assert(param != 0 && arg != 0); assert(param != 0 && arg != 0);
@ -376,7 +376,7 @@ CodeParameters(param, arg)
left = arg->nd_left; left = arg->nd_left;
left_type = left->nd_type; left_type = left->nd_type;
if (IsConformantArray(tp)) { if (IsConformantArray(tp)) {
register struct type *elem = tp->arr_elem; register t_type *elem = tp->arr_elem;
C_loc(tp->arr_elsize); C_loc(tp->arr_elsize);
if (IsConformantArray(left_type)) { if (IsConformantArray(left_type)) {
@ -388,9 +388,9 @@ CodeParameters(param, arg)
C_loc(left_type->arr_elem->tp_size); C_loc(left_type->arr_elem->tp_size);
C_mli(word_size); C_mli(word_size);
if (elem == word_type) { if (elem == word_type) {
C_loc(word_size - 1); c_loc((int) word_size - 1);
C_adi(word_size); C_adi(word_size);
C_loc(word_size); c_loc((int) word_size);
C_dvi(word_size); C_dvi(word_size);
} }
else { else {
@ -412,7 +412,7 @@ CodeParameters(param, arg)
getbounds(IndexType(left_type), &lb, &ub); getbounds(IndexType(left_type), &lb, &ub);
C_loc(ub - lb); C_loc(ub - lb);
} }
C_loc((arith) 0); c_loc(0);
if (left->nd_symb == STRING) { if (left->nd_symb == STRING) {
CodeString(left); CodeString(left);
} }
@ -447,8 +447,8 @@ CodeParameters(param, arg)
} }
CodePString(nd, tp) CodePString(nd, tp)
struct node *nd; t_node *nd;
struct type *tp; t_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;
@ -463,11 +463,11 @@ CodePString(nd, tp)
} }
CodeStd(nd) CodeStd(nd)
struct node *nd; t_node *nd;
{ {
register struct node *arg = nd->nd_right; register t_node *arg = nd->nd_right;
register struct node *left = 0; register t_node *left = 0;
register struct type *tp; register t_type *tp;
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) {
@ -493,7 +493,7 @@ CodeStd(nd)
case S_CAP: case S_CAP:
CodePExpr(left); CodePExpr(left);
C_loc((arith) 0137); /* ASCII assumed */ c_loc(0137); /* ASCII assumed */
C_and(word_size); C_and(word_size);
break; break;
@ -514,7 +514,7 @@ CodeStd(nd)
case S_ODD: case S_ODD:
CodePExpr(left); CodePExpr(left);
if (tp->tp_size == word_size) { if (tp->tp_size == word_size) {
C_loc((arith) 1); c_loc(1);
C_and(word_size); C_and(word_size);
} }
else { else {
@ -541,7 +541,7 @@ CodeStd(nd)
CodeCoercion(arg->nd_left->nd_type, tp); CodeCoercion(arg->nd_left->nd_type, tp);
} }
else { else {
C_loc((arith) 1); c_loc(1);
CodeCoercion(intorcard_type, tp); CodeCoercion(intorcard_type, tp);
} }
if (std == S_DEC) { if (std == S_DEC) {
@ -585,7 +585,7 @@ CodeStd(nd)
} }
RangeCheck(tpl, tpr) RangeCheck(tpl, tpr)
register struct type *tpl, *tpr; register t_type *tpl, *tpr;
{ {
/* Generate a range check if neccessary /* Generate a range check if neccessary
*/ */
@ -621,14 +621,14 @@ RangeCheck(tpl, tpr)
C_dup(word_size); C_dup(word_size);
C_zge(lb); C_zge(lb);
C_loc((arith) ECONV); c_loc(ECONV);
C_trp(); C_trp();
C_df_ilb(lb); C_df_ilb(lb);
} }
} }
Operands(leftop, rightop) Operands(leftop, rightop)
register struct node *leftop, *rightop; register t_node *leftop, *rightop;
{ {
CodePExpr(leftop); CodePExpr(leftop);
@ -636,13 +636,13 @@ Operands(leftop, rightop)
} }
CodeOper(expr, true_label, false_label) CodeOper(expr, true_label, false_label)
register struct node *expr; /* the expression tree itself */ register t_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 struct node *leftop = expr->nd_left; register t_node *leftop = expr->nd_left;
register struct node *rightop = expr->nd_right; register t_node *rightop = expr->nd_right;
register struct type *tp = expr->nd_type; register t_type *tp = expr->nd_type;
switch (expr->nd_symb) { switch (expr->nd_symb) {
case '+': case '+':
@ -830,7 +830,7 @@ CodeOper(expr, true_label, false_label)
case OR: case OR:
case AND: { case AND: {
label l_maybe = ++text_label, l_end; label l_maybe = ++text_label, l_end;
struct desig *Des = new_desig(); t_desig *Des = new_desig();
int genlabels = 0; int genlabels = 0;
if (true_label == NO_LABEL) { if (true_label == NO_LABEL) {
@ -850,10 +850,10 @@ CodeOper(expr, true_label, false_label)
CodeExpr(rightop, Des, true_label, false_label); CodeExpr(rightop, Des, true_label, false_label);
if (genlabels) { if (genlabels) {
C_df_ilb(true_label); C_df_ilb(true_label);
C_loc((arith)1); c_loc(1);
C_bra(l_end); C_bra(l_end);
C_df_ilb(false_label); C_df_ilb(false_label);
C_loc((arith)0); c_loc(0);
C_df_ilb(l_end); C_df_ilb(l_end);
} }
free_desig(Des); free_desig(Des);
@ -922,9 +922,9 @@ truthvalue(relop)
} }
CodeUoper(nd) CodeUoper(nd)
register struct node *nd; register t_node *nd;
{ {
register struct type *tp = nd->nd_type; register t_type *tp = nd->nd_type;
CodePExpr(nd->nd_right); CodePExpr(nd->nd_right);
switch(nd->nd_symb) { switch(nd->nd_symb) {
@ -954,9 +954,9 @@ CodeUoper(nd)
} }
CodeSet(nd) CodeSet(nd)
register struct node *nd; register t_node *nd;
{ {
register struct type *tp = nd->nd_type; register t_type *tp = nd->nd_type;
nd = nd->nd_right; nd = nd->nd_right;
while (nd) { while (nd) {
@ -968,10 +968,10 @@ CodeSet(nd)
} }
CodeEl(nd, tp) CodeEl(nd, tp)
register struct node *nd; register t_node *nd;
register struct type *tp; register t_type *tp;
{ {
register struct type *eltype = ElementType(tp); register t_type *eltype = ElementType(tp);
if (nd->nd_class == Link && nd->nd_symb == UPTO) { if (nd->nd_class == Link && nd->nd_symb == UPTO) {
C_loc(tp->tp_size); /* push size */ C_loc(tp->tp_size); /* push size */
@ -991,12 +991,12 @@ CodeEl(nd, tp)
} }
CodePExpr(nd) CodePExpr(nd)
register struct node *nd; register t_node *nd;
{ {
/* 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.
*/ */
register struct desig *designator = new_desig(); register t_desig *designator = new_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);
@ -1004,13 +1004,13 @@ CodePExpr(nd)
} }
CodeDAddress(nd) CodeDAddress(nd)
struct node *nd; t_node *nd;
{ {
/* 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.
*/ */
register struct desig *designator = new_desig(); register t_desig *designator = new_desig();
ChkForFOR(nd); ChkForFOR(nd);
CodeDesig(nd, designator); CodeDesig(nd, designator);
@ -1019,13 +1019,13 @@ CodeDAddress(nd)
} }
CodeDStore(nd) CodeDStore(nd)
register struct node *nd; register t_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".
*/ */
register struct desig *designator = new_desig(); register t_desig *designator = new_desig();
ChkForFOR(nd); ChkForFOR(nd);
CodeDesig(nd, designator); CodeDesig(nd, designator);
@ -1034,7 +1034,7 @@ CodeDStore(nd)
} }
DoHIGH(df) DoHIGH(df)
register struct def *df; register t_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
@ -1055,3 +1055,16 @@ DoHIGH(df)
} }
else C_lol(highoff); else C_lol(highoff);
} }
#ifdef SQUEEZE
c_loc(n)
{
C_loc((arith) n);
}
c_lae_dlb(l)
label l;
{
C_lae_dlb(l, (arith) 0);
}
#endif

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

@ -38,12 +38,12 @@ extern char options[];
static char ovflow[] = "overflow in constant expression"; static char ovflow[] = "overflow in constant expression";
cstunary(expp) cstunary(expp)
register struct node *expp; register t_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 restored in expp. expression below it, and the result restored in expp.
*/ */
register struct node *right = expp->nd_right; register t_node *right = expp->nd_right;
switch(expp->nd_symb) { switch(expp->nd_symb) {
/* Should not get here /* Should not get here
@ -75,7 +75,7 @@ cstunary(expp)
} }
cstbin(expp) cstbin(expp)
register struct node *expp; register t_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
@ -236,10 +236,11 @@ cstbin(expp)
} }
cstset(expp) cstset(expp)
register struct node *expp; register t_node *expp;
{ {
extern arith *MkSet();
register arith *set1, *set2; register arith *set1, *set2;
arith *resultset = 0; register arith *resultset;
register unsigned int setsize; register unsigned int setsize;
register int j; register int j;
@ -259,114 +260,90 @@ cstset(expp)
expp->nd_INT = (expp->nd_left->nd_INT >= 0 && expp->nd_INT = (expp->nd_left->nd_INT >= 0 &&
expp->nd_left->nd_INT < setsize * wrd_bits && expp->nd_left->nd_INT < setsize * wrd_bits &&
(set2[i / wrd_bits] & (1 << (i % wrd_bits)))); (set2[i / wrd_bits] & (1 << (i % wrd_bits))));
free((char *) set2); FreeSet(set2);
expp->nd_symb = INTEGER; expp->nd_symb = INTEGER;
} FreeNode(expp->nd_left);
else { FreeNode(expp->nd_right);
set1 = expp->nd_left->nd_set; expp->nd_left = expp->nd_right = 0;
resultset = set1;
expp->nd_left->nd_set = 0;
switch(expp->nd_symb) {
case '+':
/* Set union
*/
for (j = 0; j < setsize; j++) {
*set1++ |= *set2++;
}
break;
case '-':
/* Set difference
*/
for (j = 0; j < setsize; j++) {
*set1++ &= ~*set2++;
}
break;
case '*':
/* Set intersection
*/
for (j = 0; j < setsize; j++) {
*set1++ &= *set2++;
}
break;
case '/':
/* Symmetric set difference
*/
for (j = 0; j < setsize; j++) {
*set1++ ^= *set2++;
}
break;
case GREATEREQUAL:
case LESSEQUAL:
case '=':
case '#':
/* Constant set comparisons
*/
expp->nd_left->nd_set = set1; /* may be disposed of */
for (j = 0; j < setsize; j++) {
switch(expp->nd_symb) {
case GREATEREQUAL:
if ((*set1 | *set2++) != *set1) break;
set1++;
continue;
case LESSEQUAL:
if ((*set2 | *set1++) != *set2) break;
set2++;
continue;
case '=':
case '#':
if (*set1++ != *set2++) break;
continue;
}
break;
}
if (j < setsize) {
expp->nd_INT = expp->nd_symb == '#';
}
else {
expp->nd_INT = expp->nd_symb != '#';
}
expp->nd_class = Value;
expp->nd_symb = INTEGER;
freesets(expp);
return;
default:
crash("(cstset)");
}
freesets(expp);
expp->nd_class = Set;
expp->nd_set = resultset;
return; return;
} }
FreeNode(expp->nd_left);
FreeNode(expp->nd_right);
expp->nd_left = expp->nd_right = 0;
}
freesets(expp) set1 = expp->nd_left->nd_set;
register struct node *expp; switch(expp->nd_symb) {
{ case '+': /* Set union */
if (expp->nd_right->nd_set) { case '-': /* Set difference */
free((char *) expp->nd_right->nd_set); case '*': /* Set intersection */
} case '/': /* Symmetric set difference */
if (expp->nd_left->nd_set) { expp->nd_set = resultset = MkSet(setsize * (unsigned) word_size);
free((char *) expp->nd_left->nd_set); for (j = 0; j < setsize; j++) {
switch(expp->nd_symb) {
case '+':
*resultset = *set1++ | *set2++;
break;
case '-':
*resultset = *set1++ & ~*set2++;
break;
case '*':
*resultset = *set1++ & *set2++;
break;
case '/':
*resultset = *set1++ ^ *set2++;
break;
}
resultset++;
}
expp->nd_class = Set;
break;
case GREATEREQUAL:
case LESSEQUAL:
case '=':
case '#':
/* Constant set comparisons
*/
for (j = 0; j < setsize; j++) {
switch(expp->nd_symb) {
case GREATEREQUAL:
if ((*set1 | *set2++) != *set1) break;
set1++;
continue;
case LESSEQUAL:
if ((*set2 | *set1++) != *set2) break;
set2++;
continue;
case '=':
case '#':
if (*set1++ != *set2++) break;
continue;
}
break;
}
if (j < setsize) {
expp->nd_INT = expp->nd_symb == '#';
}
else {
expp->nd_INT = expp->nd_symb != '#';
}
expp->nd_class = Value;
expp->nd_symb = INTEGER;
break;
default:
crash("(cstset)");
} }
FreeSet(expp->nd_left->nd_set);
FreeSet(expp->nd_right->nd_set);
FreeNode(expp->nd_left); FreeNode(expp->nd_left);
FreeNode(expp->nd_right); FreeNode(expp->nd_right);
expp->nd_left = expp->nd_right = 0; expp->nd_left = expp->nd_right = 0;
} }
cstcall(expp, call) cstcall(expp, call)
register struct node *expp; register t_node *expp;
{ {
/* 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 struct node *expr = 0; register t_node *expr = 0;
assert(expp->nd_class == Call); assert(expp->nd_class == Call);
@ -440,13 +417,13 @@ cstcall(expp, call)
} }
CutSize(expr) CutSize(expr)
register struct node *expr; register t_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 arith o1 = expr->nd_INT; register arith o1 = expr->nd_INT;
register struct type *tp = BaseType(expr->nd_type); register t_type *tp = BaseType(expr->nd_type);
int uns; int uns;
int size = tp->tp_size; int size = tp->tp_size;

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

@ -32,13 +32,13 @@ 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 */
#define needs_static_link() (proclevel > 1) #define needs_static_link() (proclevel > 1)
extern struct node *EmptyStatement; extern t_node *EmptyStatement;
} }
/* inline in declaration: need space /* inline in declaration: need space
ProcedureDeclaration ProcedureDeclaration
{ {
struct def *df; t_def *df;
} : } :
{ ++proclevel; } { ++proclevel; }
ProcedureHeading(&df, D_PROCEDURE) ProcedureHeading(&df, D_PROCEDURE)
@ -50,9 +50,9 @@ ProcedureDeclaration
; ;
*/ */
ProcedureHeading(struct def **pdf; int type;) ProcedureHeading(t_def **pdf; int type;)
{ {
struct type *tp = 0; t_type *tp = 0;
arith parmaddr = needs_static_link() ? pointer_size : 0; arith parmaddr = needs_static_link() ? pointer_size : 0;
struct paramlist *pr = 0; struct paramlist *pr = 0;
} : } :
@ -78,7 +78,7 @@ warning(W_STRICT, "procedure \"%s\" has a constructed result type",
} }
; ;
block(struct node **pnd;) : block(t_node **pnd;) :
[ %persistent [ %persistent
declaration declaration
]* ]*
@ -94,7 +94,7 @@ block(struct node **pnd;) :
declaration declaration
{ {
struct def *df; t_def *df;
} : } :
CONST [ ConstantDeclaration ';' ]* CONST [ ConstantDeclaration ';' ]*
| |
@ -116,7 +116,7 @@ declaration
; ;
/* inline in procedureheading: need space /* inline in procedureheading: need space
FormalParameters(struct paramlist **ppr; arith *parmaddr; struct type **ptp;): FormalParameters(struct paramlist **ppr; arith *parmaddr; t_type **ptp;):
'(' '('
[ [
FPSection(ppr, parmaddr) FPSection(ppr, parmaddr)
@ -132,15 +132,15 @@ FormalParameters(struct paramlist **ppr; arith *parmaddr; struct type **ptp;):
FPSection(struct paramlist **ppr; arith *parmaddr;) FPSection(struct paramlist **ppr; arith *parmaddr;)
{ {
struct node *FPList; t_node *FPList;
struct type *tp; t_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(struct type **ptp;) FormalType(t_type **ptp;)
{ {
extern arith ArrayElSize(); extern arith ArrayElSize();
} : } :
@ -148,7 +148,7 @@ 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 struct type *tp = construct_type(T_ARRAY, card_type); register t_type *tp = construct_type(T_ARRAY, card_type);
tp->arr_elem = *ptp; tp->arr_elem = *ptp;
*ptp = tp; *ptp = tp;
@ -161,20 +161,20 @@ FormalType(struct type **ptp;)
TypeDeclaration TypeDeclaration
{ {
struct def *df; t_def *df;
struct type *tp; t_type *tp;
register struct node *nd; register t_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);
} }
'=' type(&tp) '=' type(&tp)
{ DeclareType(nd, df, tp); { DeclareType(nd, df, tp);
free_node(nd); FreeNode(nd);
} }
; ;
type(register struct type **ptp;): type(register t_type **ptp;):
%default SimpleType(ptp) %default SimpleType(ptp)
| |
ArrayType(ptp) ArrayType(ptp)
@ -188,9 +188,9 @@ type(register struct type **ptp;):
ProcedureType(ptp) ProcedureType(ptp)
; ;
SimpleType(register struct type **ptp;) SimpleType(register t_type **ptp;)
{ {
struct type *tp; t_type *tp;
} : } :
qualtype(ptp) qualtype(ptp)
[ [
@ -208,17 +208,17 @@ SimpleType(register struct type **ptp;)
SubrangeType(ptp) SubrangeType(ptp)
; ;
enumeration(struct type **ptp;) enumeration(t_type **ptp;)
{ {
struct node *EnumList; t_node *EnumList;
} : } :
'(' IdentList(&EnumList) ')' '(' IdentList(&EnumList) ')'
{ *ptp = enum_type(EnumList); } { *ptp = enum_type(EnumList); }
; ;
IdentList(struct node **p;) IdentList(t_node **p;)
{ {
register struct node *q; register t_node *q;
} : } :
IDENT { *p = q = dot2leaf(Value); } IDENT { *p = q = dot2leaf(Value); }
[ %persistent [ %persistent
@ -230,9 +230,9 @@ IdentList(struct node **p;)
{ q->nd_left = 0; } { q->nd_left = 0; }
; ;
SubrangeType(struct type **ptp;) SubrangeType(t_type **ptp;)
{ {
struct node *nd1, *nd2; t_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
@ -242,15 +242,15 @@ SubrangeType(struct type **ptp;)
UPTO ConstExpression(&nd2) UPTO ConstExpression(&nd2)
']' ']'
{ *ptp = subr_type(nd1, nd2); { *ptp = subr_type(nd1, nd2);
free_node(nd1); FreeNode(nd1);
free_node(nd2); FreeNode(nd2);
} }
; ;
ArrayType(struct type **ptp;) ArrayType(t_type **ptp;)
{ {
struct type *tp; t_type *tp;
register struct type *tp2; register t_type *tp2;
} : } :
ARRAY SimpleType(&tp) ARRAY SimpleType(&tp)
{ *ptp = tp2 = construct_type(T_ARRAY, tp); } { *ptp = tp2 = construct_type(T_ARRAY, tp); }
@ -265,7 +265,7 @@ ArrayType(struct type **ptp;)
} }
; ;
RecordType(struct type **ptp;) RecordType(t_type **ptp;)
{ {
register struct scope *scope; register struct scope *scope;
arith size = 0; arith size = 0;
@ -294,10 +294,10 @@ FieldListSequence(struct scope *scope; arith *cnt; int *palign;):
FieldList(struct scope *scope; arith *cnt; int *palign;) FieldList(struct scope *scope; arith *cnt; int *palign;)
{ {
struct node *FldList; t_node *FldList;
struct type *tp; t_type *tp;
struct node *nd; t_node *nd;
register struct def *df; register t_def *df;
arith tcnt, max; arith tcnt, max;
} : } :
[ [
@ -358,9 +358,9 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
]? ]?
; ;
variant(struct scope *scope; arith *cnt; struct type *tp; int *palign;) variant(struct scope *scope; arith *cnt; t_type *tp; int *palign;)
{ {
struct node *nd; t_node *nd;
} : } :
[ [
CaseLabelList(&tp, &nd) CaseLabelList(&tp, &nd)
@ -375,7 +375,7 @@ variant(struct scope *scope; arith *cnt; struct type *tp; int *palign;)
/* Changed rule in new modula-2 */ /* Changed rule in new modula-2 */
; ;
CaseLabelList(struct type **ptp; struct node **pnd;): CaseLabelList(t_type **ptp; t_node **pnd;):
CaseLabels(ptp, pnd) CaseLabels(ptp, pnd)
[ [
{ *pnd = dot2node(Link, *pnd, NULLNODE); } { *pnd = dot2node(Link, *pnd, NULLNODE); }
@ -384,9 +384,9 @@ CaseLabelList(struct type **ptp; struct node **pnd;):
]* ]*
; ;
CaseLabels(struct type **ptp; register struct node **pnd;) CaseLabels(t_type **ptp; register t_node **pnd;)
{ {
register struct node *nd; register t_node *nd;
}: }:
ConstExpression(pnd) ConstExpression(pnd)
{ {
@ -409,7 +409,7 @@ CaseLabels(struct type **ptp; register struct node **pnd;)
} }
; ;
SetType(struct type **ptp;) : SetType(t_type **ptp;) :
SET OF SimpleType(ptp) SET OF SimpleType(ptp)
{ *ptp = set_type(*ptp); } { *ptp = set_type(*ptp); }
; ;
@ -418,7 +418,7 @@ SetType(struct 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 struct type **ptp;) : PointerType(register t_type **ptp;) :
{ *ptp = construct_type(T_POINTER, NULLTYPE); } { *ptp = construct_type(T_POINTER, NULLTYPE); }
POINTER TO POINTER TO
[ %if (type_or_forward(ptp)) [ %if (type_or_forward(ptp))
@ -428,27 +428,27 @@ PointerType(register struct type **ptp;) :
] ]
; ;
qualtype(struct type **ptp;) qualtype(t_type **ptp;)
{ {
struct node *nd; t_node *nd;
} : } :
qualident(&nd) qualident(&nd)
{ *ptp = qualified_type(nd); } { *ptp = qualified_type(nd); }
; ;
ProcedureType(struct type **ptp;) : ProcedureType(t_type **ptp;) :
PROCEDURE PROCEDURE
[ [
FormalTypeList(ptp) FormalTypeList(ptp)
| |
{ *ptp = proc_type((struct type *) 0, { *ptp = proc_type((t_type *) 0,
(struct paramlist *) 0, (struct paramlist *) 0,
(arith) 0); (arith) 0);
} }
] ]
; ;
FormalTypeList(struct type **ptp;) FormalTypeList(t_type **ptp;)
{ {
struct paramlist *pr = 0; struct paramlist *pr = 0;
arith parmaddr = 0; arith parmaddr = 0;
@ -469,7 +469,7 @@ FormalTypeList(struct type **ptp;)
VarFormalType(struct paramlist **ppr; arith *parmaddr;) VarFormalType(struct paramlist **ppr; arith *parmaddr;)
{ {
struct type *tp; t_type *tp;
int isvar; int isvar;
} : } :
var(&isvar) var(&isvar)
@ -487,9 +487,9 @@ var(int *VARp;) :
ConstantDeclaration ConstantDeclaration
{ {
struct idf *id; t_idf *id;
struct node *nd; t_node *nd;
register struct def *df; register t_def *df;
}: }:
IDENT { id = dot.TOK_IDF; } IDENT { id = dot.TOK_IDF; }
'=' ConstExpression(&nd) '=' ConstExpression(&nd)
@ -502,9 +502,9 @@ ConstantDeclaration
VariableDeclaration VariableDeclaration
{ {
struct node *VarList; t_node *VarList;
register struct node *nd; register t_node *nd;
struct type *tp; t_type *tp;
} : } :
IdentAddr(&VarList) IdentAddr(&VarList)
{ nd = VarList; } { nd = VarList; }
@ -516,9 +516,9 @@ VariableDeclaration
{ EnterVarList(VarList, tp, proclevel > 0); } { EnterVarList(VarList, tp, proclevel > 0); }
; ;
IdentAddr(struct node **pnd;) IdentAddr(t_node **pnd;)
{ {
register struct node *nd; register t_node *nd;
} : } :
IDENT { nd = dot2leaf(Name); } IDENT { nd = dot2leaf(Name); }
[ '[' [ '['

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

@ -128,15 +128,15 @@ struct def { /* list of definitions for a name */
} df_value; } df_value;
}; };
typedef struct def t_def;
/* ALLOCDEF "def" 50 */ /* ALLOCDEF "def" 50 */
extern struct def extern t_def
*define(), *define(),
*DefineLocalModule(), *DefineLocalModule(),
*MkDef(), *MkDef(),
*DeclProc(); *DeclProc(),
extern struct def
*lookup(), *lookup(),
*lookfor(); *lookfor();
#define NULLDEF ((struct def *) 0)
#define NULLDEF ((t_def *) 0)

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

@ -27,14 +27,14 @@
STATIC STATIC
DefInFront(df) DefInFront(df)
register struct def *df; register t_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 struct def *df1 = df->df_scope->sc_def; register t_def *df1 = df->df_scope->sc_def;
if (df1 != df) { if (df1 != df) {
/* Definition "df" is not in front of the list /* Definition "df" is not in front of the list
@ -58,15 +58,15 @@ DefInFront(df)
} }
} }
struct def * t_def *
MkDef(id, scope, kind) MkDef(id, scope, kind)
register struct idf *id; register t_idf *id;
register struct scope *scope; register struct scope *scope;
{ {
/* 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 struct def *df; register t_def *df;
df = new_def(); df = new_def();
df->df_idf = id; df->df_idf = id;
@ -82,9 +82,9 @@ MkDef(id, scope, kind)
return df; return df;
} }
struct def * t_def *
define(id, scope, kind) define(id, scope, kind)
register struct idf *id; register t_idf *id;
register struct scope *scope; register struct scope *scope;
int kind; int kind;
{ {
@ -93,7 +93,7 @@ define(id, scope, kind)
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 struct def *df; register t_def *df;
df = lookup(id, scope, 1); df = lookup(id, scope, 1);
if ( /* Already in this scope */ if ( /* Already in this scope */
@ -180,13 +180,13 @@ define(id, scope, kind)
} }
RemoveImports(pdf) RemoveImports(pdf)
register struct def **pdf; register t_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.
*/ */
register struct def *df = *pdf; register t_def *df = *pdf;
while (df) { while (df) {
if (df->df_kind == D_IMPORT) { if (df->df_kind == D_IMPORT) {
@ -202,12 +202,12 @@ RemoveImports(pdf)
} }
RemoveFromIdList(df) RemoveFromIdList(df)
register struct def *df; register t_def *df;
{ {
/* Remove definition "df" from the definition list /* Remove definition "df" from the definition list
*/ */
register struct idf *id = df->df_idf; register t_idf *id = df->df_idf;
register struct def *df1; register t_def *df1;
if ((df1 = id->id_def) == df) id->id_def = df->df_next; if ((df1 = id->id_def) == df) id->id_def = df->df_next;
else { else {
@ -219,15 +219,15 @@ RemoveFromIdList(df)
} }
} }
struct def * t_def *
DeclProc(type, id) DeclProc(type, id)
register struct idf *id; register t_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 struct def *df; register t_def *df;
register struct scope *scope; register struct scope *scope;
extern char *sprint(); extern char *sprint();
static int nmcount; static int nmcount;
@ -286,8 +286,8 @@ DeclProc(type, id)
} }
EndProc(df, id) EndProc(df, id)
register struct def *df; register t_def *df;
struct idf *id; t_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
@ -304,14 +304,14 @@ EndProc(df, id)
} }
} }
struct def * t_def *
DefineLocalModule(id) DefineLocalModule(id)
struct idf *id; t_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 struct def *df = define(id, CurrentScope, D_MODULE); register t_def *df = define(id, CurrentScope, D_MODULE);
register struct scope *sc; register struct scope *sc;
static int modulecount = 0; static int modulecount = 0;
char buf[256]; char buf[256];
@ -352,8 +352,8 @@ DefineLocalModule(id)
} }
CheckWithDef(df, tp) CheckWithDef(df, tp)
register struct def *df; register t_def *df;
struct type *tp; t_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.
@ -374,7 +374,7 @@ CheckWithDef(df, tp)
#ifdef DEBUG #ifdef DEBUG
PrDef(df) PrDef(df)
register struct def *df; register t_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);
} }

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

@ -32,7 +32,7 @@
long sys_filesize(); long sys_filesize();
#endif #endif
struct idf *DefId; t_idf *DefId;
char * char *
getwdir(fn) getwdir(fn)
@ -80,16 +80,16 @@ GetFile(name)
return 1; return 1;
} }
struct def * t_def *
GetDefinitionModule(id, incr) GetDefinitionModule(id, incr)
register struct idf *id; register t_idf *id;
{ {
/* 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 struct def *df; register t_def *df;
static int level; static int level;
struct scopelist *vis; struct scopelist *vis;
char *fn = FileName; char *fn = FileName;
@ -124,9 +124,9 @@ GetDefinitionModule(id, incr)
remember its name because we have remember its name because we have
to call its initialization routine to call its initialization routine
*/ */
static struct node *nd_end; static t_node *nd_end;
register struct node *n; register t_node *n;
extern struct node *Modules; extern t_node *Modules;
n = dot2leaf(Name); n = dot2leaf(Name);
n->nd_IDF = id; n->nd_IDF = id;

4
lang/m2/comp/desig.H
View file

@ -45,6 +45,8 @@ struct desig {
*/ */
}; };
typedef struct desig t_desig;
/* ALLOCDEF "desig" 5 */ /* ALLOCDEF "desig" 5 */
/* The next structure describes the designator in a with-statement. /* The next structure describes the designator in a with-statement.
@ -56,7 +58,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
*/ */
struct desig w_desig; /* a desig structure for this particular t_desig w_desig; /* a desig structure for this particular
designator designator
*/ */
}; };

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

@ -24,6 +24,7 @@
#include <assert.h> #include <assert.h>
#include <alloc.h> #include <alloc.h>
#include "squeeze.h"
#include "type.h" #include "type.h"
#include "LLlex.h" #include "LLlex.h"
#include "def.h" #include "def.h"
@ -31,65 +32,74 @@
#include "desig.h" #include "desig.h"
#include "node.h" #include "node.h"
#include "warning.h" #include "warning.h"
#include "walk.h"
extern int proclevel; extern int proclevel;
int int
WordOrDouble(ds, size) WordOrDouble(ds, size)
register struct desig *ds; register t_desig *ds;
arith size; arith size;
{ {
return ((int) (ds->dsg_offset) % (int) word_size == 0 && if ((int) (ds->dsg_offset) % (int) word_size == 0) {
( (int) size == (int) word_size || if (size == word_size) return 1;
(int) size == (int) dword_size)); if (size == dword_size) return 2;
}
return 0;
} }
int int
DoLoad(ds, size) DoLoad(ds, size)
register struct desig *ds; register t_desig *ds;
arith size; arith size;
{ {
if (! WordOrDouble(ds, size)) return 0; switch (WordOrDouble(ds, size)) {
if (ds->dsg_name) { default:
if ((int) size == (int) word_size) { return 0;
case 1:
if (ds->dsg_name) {
C_loe_dnam(ds->dsg_name, ds->dsg_offset); C_loe_dnam(ds->dsg_name, ds->dsg_offset);
} }
else C_lde_dnam(ds->dsg_name, ds->dsg_offset); else C_lol(ds->dsg_offset);
} break;
else { case 2:
if ((int) size == (int) word_size) { if (ds->dsg_name) {
C_lol(ds->dsg_offset); C_lde_dnam(ds->dsg_name, ds->dsg_offset);
} }
else C_ldl(ds->dsg_offset); else C_ldl(ds->dsg_offset);
break;
} }
return 1; return 1;
} }
int int
DoStore(ds, size) DoStore(ds, size)
register struct desig *ds; register t_desig *ds;
arith size; arith size;
{ {
if (! WordOrDouble(ds, size)) return 0; switch (WordOrDouble(ds, size)) {
if (ds->dsg_name) { default:
if ((int) size == (int) word_size) { return 0;
case 1:
if (ds->dsg_name) {
C_ste_dnam(ds->dsg_name, ds->dsg_offset); C_ste_dnam(ds->dsg_name, ds->dsg_offset);
} }
else C_sde_dnam(ds->dsg_name, ds->dsg_offset); else C_stl(ds->dsg_offset);
} break;
else { case 2:
if ((int) size == (int) word_size) { if (ds->dsg_name) {
C_stl(ds->dsg_offset); C_sde_dnam(ds->dsg_name, ds->dsg_offset);
} }
else C_sdl(ds->dsg_offset); else C_sdl(ds->dsg_offset);
break;
} }
return 1; return 1;
} }
STATIC int STATIC int
properly(ds, tp) properly(ds, tp)
register struct desig *ds; register t_desig *ds;
register struct type *tp; register t_type *tp;
{ {
/* Check if it is allowed to load or store the value indicated /* Check if it is allowed to load or store the value indicated
by "ds" with LOI/STI. by "ds" with LOI/STI.
@ -115,8 +125,8 @@ properly(ds, tp)
} }
CodeValue(ds, tp) CodeValue(ds, tp)
register struct desig *ds; register t_desig *ds;
register struct type *tp; register t_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"
@ -167,10 +177,10 @@ CodeValue(ds, tp)
} }
ChkForFOR(nd) ChkForFOR(nd)
struct node *nd; t_node *nd;
{ {
if (nd->nd_class == Def) { if (nd->nd_class == Def) {
register struct def *df = nd->nd_def; register t_def *df = nd->nd_def;
if (df->df_flags & D_FORLOOP) { if (df->df_flags & D_FORLOOP) {
node_warning(nd, node_warning(nd,
@ -182,13 +192,13 @@ ChkForFOR(nd)
} }
CodeStore(ds, tp) CodeStore(ds, tp)
register struct desig *ds; register t_desig *ds;
register struct type *tp; register t_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"
*/ */
struct desig save; t_desig save;
save = *ds; save = *ds;
@ -220,10 +230,10 @@ CodeStore(ds, tp)
} }
CodeCopy(lhs, rhs, sz, psize) CodeCopy(lhs, rhs, sz, psize)
register struct desig *lhs, *rhs; register t_desig *lhs, *rhs;
arith sz, *psize; arith sz, *psize;
{ {
struct desig l, r; t_desig l, r;
l = *lhs; r = *rhs; l = *lhs; r = *rhs;
*psize -= sz; *psize -= sz;
@ -236,12 +246,12 @@ CodeCopy(lhs, rhs, sz, psize)
} }
CodeMove(rhs, left, rtp) CodeMove(rhs, left, rtp)
register struct desig *rhs; register t_desig *rhs;
register struct node *left; register t_node *left;
struct type *rtp; t_type *rtp;
{ {
register struct desig *lhs = new_desig(); register t_desig *lhs = new_desig();
register struct type *tp = left->nd_type; register t_type *tp = left->nd_type;
int loadedflag = 0; int loadedflag = 0;
/* Generate code for an assignment. Testing of type /* Generate code for an assignment. Testing of type
@ -297,7 +307,7 @@ CodeMove(rhs, left, rtp)
if (size > 3*dword_size) { if (size > 3*dword_size) {
/* Do a block move /* Do a block move
*/ */
struct desig l, r; t_desig l, r;
arith sz; arith sz;
sz = (size / word_size) * word_size; sz = (size / word_size) * word_size;
@ -365,7 +375,7 @@ CodeMove(rhs, left, rtp)
} }
CodeAddress(ds) CodeAddress(ds)
register struct desig *ds; register t_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"
@ -404,8 +414,8 @@ CodeAddress(ds)
} }
CodeFieldDesig(df, ds) CodeFieldDesig(df, ds)
register struct def *df; register t_def *df;
register struct desig *ds; register t_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
@ -455,8 +465,8 @@ CodeFieldDesig(df, ds)
} }
CodeVarDesig(df, ds) CodeVarDesig(df, ds)
register struct def *df; register t_def *df;
register struct desig *ds; register t_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,
@ -532,13 +542,13 @@ CodeVarDesig(df, ds)
} }
CodeDesig(nd, ds) CodeDesig(nd, ds)
register struct node *nd; register t_node *nd;
register struct desig *ds; register t_desig *ds;
{ {
/* Generate code for a designator. Use divide and conquer /* Generate code for a designator. Use divide and conquer
principle principle
*/ */
register struct def *df; register t_def *df;
switch(nd->nd_class) { /* Divide */ switch(nd->nd_class) { /* Divide */
case Def: case Def:
@ -579,7 +589,7 @@ CodeDesig(nd, ds)
else C_lal(df->var_off + pointer_size); else C_lal(df->var_off + pointer_size);
} }
else { else {
C_lae_dlb(nd->nd_left->nd_type->arr_descr, (arith) 0); c_lae_dlb(nd->nd_left->nd_type->arr_descr);
} }
ds->dsg_kind = DSG_INDEXED; ds->dsg_kind = DSG_INDEXED;
break; break;

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

@ -27,16 +27,16 @@
#include "misc.h" #include "misc.h"
#include "f_info.h" #include "f_info.h"
struct def * t_def *
Enter(name, kind, type, pnam) Enter(name, kind, type, pnam)
char *name; char *name;
struct type *type; t_type *type;
{ {
/* 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 struct def *df; register t_def *df;
df = define(str2idf(name, 0), CurrentScope, kind); df = define(str2idf(name, 0), CurrentScope, kind);
df->df_type = type; df->df_type = type;
@ -46,7 +46,7 @@ Enter(name, kind, type, pnam)
EnterType(name, type) EnterType(name, type)
char *name; char *name;
struct type *type; t_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.
@ -56,8 +56,8 @@ EnterType(name, type)
} }
EnterEnumList(Idlist, type) EnterEnumList(Idlist, type)
struct node *Idlist; t_node *Idlist;
register struct type *type; register t_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".
@ -66,8 +66,8 @@ EnterEnumList(Idlist, 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 struct def *df; register t_def *df;
register struct node *idlist = Idlist; register t_node *idlist = Idlist;
type->enm_ncst = 0; type->enm_ncst = 0;
for (; idlist; idlist = idlist->nd_left) { for (; idlist; idlist = idlist->nd_left) {
@ -81,8 +81,8 @@ EnterEnumList(Idlist, type)
} }
EnterFieldList(Idlist, type, scope, addr) EnterFieldList(Idlist, type, scope, addr)
struct node *Idlist; t_node *Idlist;
register struct type *type; register t_type *type;
struct scope *scope; struct scope *scope;
arith *addr; arith *addr;
{ {
@ -91,8 +91,8 @@ EnterFieldList(Idlist, type, scope, addr)
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 struct def *df; register t_def *df;
register struct node *idlist = Idlist; register t_node *idlist = Idlist;
for (; idlist; idlist = idlist->nd_left) { for (; idlist; idlist = idlist->nd_left) {
df = define(idlist->nd_IDF, scope, D_FIELD); df = define(idlist->nd_IDF, scope, D_FIELD);
@ -105,16 +105,16 @@ EnterFieldList(Idlist, type, scope, addr)
} }
EnterVarList(Idlist, type, local) EnterVarList(Idlist, type, local)
struct node *Idlist; t_node *Idlist;
struct type *type; t_type *type;
{ {
/* 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.
*/ */
register struct def *df; register t_def *df;
register struct node *idlist = Idlist; register t_node *idlist = Idlist;
register struct scopelist *sc = CurrVis; register struct scopelist *sc = CurrVis;
char buf[256]; char buf[256];
extern char *sprint(); extern char *sprint();
@ -132,7 +132,7 @@ EnterVarList(Idlist, type, local)
if (idlist->nd_left) { if (idlist->nd_left) {
/* An address was supplied /* An address was supplied
*/ */
register struct type *tp = idlist->nd_left->nd_type; register t_type *tp = idlist->nd_left->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,8 +180,8 @@ EnterVarList(Idlist, type, local)
EnterParamList(ppr, Idlist, type, VARp, off) EnterParamList(ppr, Idlist, type, VARp, off)
struct paramlist **ppr; struct paramlist **ppr;
struct node *Idlist; t_node *Idlist;
struct type *type; t_type *type;
int VARp; int VARp;
arith *off; arith *off;
{ {
@ -190,9 +190,9 @@ EnterParamList(ppr, Idlist, type, VARp, off)
"VARp" indicates D_VARPAR or D_VALPAR. "VARp" indicates D_VARPAR or D_VALPAR.
*/ */
register struct paramlist *pr; register struct paramlist *pr;
register struct def *df; register t_def *df;
register struct node *idlist = Idlist; register t_node *idlist = Idlist;
struct node *dummy = 0; t_node *dummy = 0;
static struct paramlist *last; static struct paramlist *last;
if (! idlist) { if (! idlist) {
@ -231,7 +231,7 @@ EnterParamList(ppr, Idlist, type, VARp, off)
STATIC STATIC
DoImport(df, scope) DoImport(df, scope)
register struct def *df; register t_def *df;
struct scope *scope; struct scope *scope;
{ {
/* Definition "df" is imported to scope "scope". /* Definition "df" is imported to scope "scope".
@ -268,8 +268,8 @@ DoImport(df, scope)
STATIC struct scopelist * STATIC struct scopelist *
ForwModule(df, nd) ForwModule(df, nd)
register struct def *df; register t_def *df;
struct node *nd; t_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.
@ -295,15 +295,15 @@ ForwModule(df, nd)
return vis; return vis;
} }
STATIC struct def * STATIC t_def *
ForwDef(ids, scope) ForwDef(ids, scope)
register struct node *ids; register t_node *ids;
struct scope *scope; 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 struct def *df; register t_def *df;
if (!(df = lookup(ids->nd_IDF, scope, 1))) { if (!(df = lookup(ids->nd_IDF, scope, 1))) {
df = define(ids->nd_IDF, scope, D_FORWARD); df = define(ids->nd_IDF, scope, D_FORWARD);
@ -313,15 +313,15 @@ ForwDef(ids, scope)
} }
EnterExportList(Idlist, qualified) EnterExportList(Idlist, qualified)
struct node *Idlist; t_node *Idlist;
{ {
/* 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".
*/ */
register struct node *idlist = Idlist; register t_node *idlist = Idlist;
register struct def *df, *df1; register t_def *df, *df1;
for (;idlist; idlist = idlist->nd_left) { for (;idlist; idlist = idlist->nd_left) {
df = lookup(idlist->nd_IDF, CurrentScope, 0); df = lookup(idlist->nd_IDF, CurrentScope, 0);
@ -389,15 +389,15 @@ EnterExportList(Idlist, qualified)
} }
EnterFromImportList(Idlist, FromDef, FromId) EnterFromImportList(Idlist, FromDef, FromId)
struct node *Idlist; t_node *Idlist;
register struct def *FromDef; register t_def *FromDef;
struct node *FromId; t_node *FromId;
{ {
/* Import the list Idlist from the module indicated by Fromdef. /* Import the list Idlist from the module indicated by Fromdef.
*/ */
register struct node *idlist = Idlist; register t_node *idlist = Idlist;
register struct scopelist *vis; register struct scopelist *vis;
register struct def *df; register t_def *df;
char *module_name = FromDef->df_idf->id_text; char *module_name = FromDef->df_idf->id_text;
int forwflag = 0; int forwflag = 0;
@ -454,16 +454,16 @@ node_error(FromId,"identifier \"%s\" does not represent a module",module_name);
} }
EnterImportList(Idlist, local) EnterImportList(Idlist, local)
struct node *Idlist; t_node *Idlist;
{ {
/* Import "Idlist" from the enclosing scope. /* Import "Idlist" from the enclosing scope.
An exception must be made for imports of the compilation unit. An exception must be made for imports of the compilation unit.
In this case, definition modules must be read for "Idlist". In this case, definition modules must be read for "Idlist".
This case is indicated by the value 0 of the "local" flag. This case is indicated by the value 0 of the "local" flag.
*/ */
register struct node *idlist = Idlist; register t_node *idlist = Idlist;
struct scope *sc = enclosing(CurrVis)->sc_scope; struct scope *sc = enclosing(CurrVis)->sc_scope;
extern struct def *GetDefinitionModule(); extern t_def *GetDefinitionModule();
struct f_info f; struct f_info f;
f = file_info; f = file_info;

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

@ -73,7 +73,7 @@ error(fmt, args)
/*VARARGS2*/ /*VARARGS2*/
node_error(node, fmt, args) node_error(node, fmt, args)
struct node *node; t_node *node;
char *fmt; char *fmt;
{ {
_error(ERROR, node, fmt, &args); _error(ERROR, node, fmt, &args);
@ -89,7 +89,7 @@ warning(class, fmt, args)
/*VARARGS2*/ /*VARARGS2*/
node_warning(node, class, fmt, args) node_warning(node, class, fmt, args)
struct node *node; t_node *node;
char *fmt; char *fmt;
{ {
warn_class = class; warn_class = class;
@ -137,7 +137,7 @@ crash(fmt, args)
_error(class, node, fmt, argv) _error(class, node, fmt, argv)
int class; int class;
struct node *node; t_node *node;
char *fmt; char *fmt;
int argv[]; int argv[];
{ {

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

@ -30,7 +30,7 @@ extern char options[];
} }
/* inline, we need room for pdp/11 /* inline, we need room for pdp/11
number(struct node **p;) : number(t_node **p;) :
[ [
%default %default
INTEGER INTEGER
@ -42,7 +42,7 @@ number(struct node **p;) :
; ;
*/ */
qualident(struct node **p;) qualident(t_node **p;)
{ {
} : } :
IDENT { *p = dot2leaf(Name); } IDENT { *p = dot2leaf(Name); }
@ -51,14 +51,14 @@ qualident(struct node **p;)
]* ]*
; ;
selector(struct node **pnd;): selector(t_node **pnd;):
'.' { *pnd = dot2node(Link,*pnd,NULLNODE); } '.' { *pnd = dot2node(Link,*pnd,NULLNODE); }
IDENT { (*pnd)->nd_IDF = dot.TOK_IDF; } IDENT { (*pnd)->nd_IDF = dot.TOK_IDF; }
; ;
ExpList(struct node **pnd;) ExpList(t_node **pnd;)
{ {
register struct node *nd; register t_node *nd;
} : } :
expression(pnd) { *pnd = nd = dot2node(Link,*pnd,NULLNODE); expression(pnd) { *pnd = nd = dot2node(Link,*pnd,NULLNODE);
nd->nd_symb = ','; nd->nd_symb = ',';
@ -71,9 +71,9 @@ ExpList(struct node **pnd;)
]* ]*
; ;
ConstExpression(struct node **pnd;) ConstExpression(t_node **pnd;)
{ {
register struct node *nd; register t_node *nd;
}: }:
expression(pnd) expression(pnd)
/* /*
@ -94,7 +94,7 @@ ConstExpression(struct node **pnd;)
} }
; ;
expression(struct node **pnd;) expression(t_node **pnd;)
{ {
} : } :
SimpleExpression(pnd) SimpleExpression(pnd)
@ -112,9 +112,9 @@ relation:
; ;
*/ */
SimpleExpression(struct node **pnd;) SimpleExpression(t_node **pnd;)
{ {
register struct node *nd = 0; register t_node *nd = 0;
} : } :
[ [
[ '+' | '-' ] [ '+' | '-' ]
@ -144,9 +144,9 @@ AddOperator:
; ;
*/ */
term(struct node **pnd;) term(t_node **pnd;)
{ {
register struct node *nd; register t_node *nd;
}: }:
factor(pnd) { nd = *pnd; } factor(pnd) { nd = *pnd; }
[ [
@ -164,9 +164,9 @@ MulOperator:
; ;
*/ */
factor(register struct node **p;) factor(register t_node **p;)
{ {
struct node *nd; t_node *nd;
} : } :
qualident(p) qualident(p)
[ [
@ -208,7 +208,7 @@ factor(register struct node **p;)
nd->nd_right = *p; nd->nd_right = *p;
*p = nd; *p = nd;
} }
else free_node(nd); else FreeNode(nd);
} }
')' ')'
| |
@ -216,9 +216,9 @@ factor(register struct node **p;)
factor(&((*p)->nd_right)) factor(&((*p)->nd_right))
; ;
bare_set(struct node **pnd;) bare_set(t_node **pnd;)
{ {
register struct node *nd; register t_node *nd;
} : } :
'{' { dot.tk_symb = SET; '{' { dot.tk_symb = SET;
*pnd = nd = dot2leaf(Xset); *pnd = nd = dot2leaf(Xset);
@ -233,13 +233,13 @@ bare_set(struct node **pnd;)
'}' '}'
; ;
ActualParameters(struct node **pnd;): ActualParameters(t_node **pnd;):
'(' ExpList(pnd)? ')' '(' ExpList(pnd)? ')'
; ;
element(register struct node *nd;) element(register t_node *nd;)
{ {
struct node *nd1; t_node *nd1;
} : } :
expression(&nd1) expression(&nd1)
[ [
@ -252,13 +252,13 @@ element(register struct node *nd;)
} }
; ;
designator(struct node **pnd;) designator(t_node **pnd;)
: :
qualident(pnd) qualident(pnd)
designator_tail(pnd)? designator_tail(pnd)?
; ;
designator_tail(struct node **pnd;): designator_tail(t_node **pnd;):
visible_designator_tail(pnd) visible_designator_tail(pnd)
[ %persistent [ %persistent
%default %default
@ -268,9 +268,9 @@ designator_tail(struct node **pnd;):
]* ]*
; ;
visible_designator_tail(struct node **pnd;) visible_designator_tail(t_node **pnd;)
{ {
register struct node *nd = *pnd; register t_node *nd = *pnd;
}: }:
[ [
'[' { nd = dot2node(Arrsel, nd, NULLNODE); } '[' { nd = dot2node(Arrsel, nd, NULLNODE); }

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

@ -19,3 +19,5 @@ struct id_u {
#define id_def id_user.id_df #define id_def id_user.id_df
#include <idf_pkg.spec> #include <idf_pkg.spec>
typedef struct idf t_idf;

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

@ -23,9 +23,9 @@
#include "type.h" #include "type.h"
#include "misc.h" #include "misc.h"
struct def * t_def *
lookup(id, scope, import) lookup(id, scope, import)
register struct idf *id; register t_idf *id;
struct scope *scope; struct scope *scope;
{ {
/* Look up a definition of an identifier in scope "scope". /* Look up a definition of an identifier in scope "scope".
@ -33,7 +33,7 @@ lookup(id, scope, import)
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 struct def *df, *df1; register t_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".
@ -62,16 +62,16 @@ lookup(id, scope, import)
return df; return df;
} }
struct def * t_def *
lookfor(id, vis, give_error) lookfor(id, vis, give_error)
register struct node *id; register t_node *id;
struct scopelist *vis; struct scopelist *vis;
{ {
/* 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 "give_error" is set, give an error message. if "give_error" is set, give an error message.
*/ */
register struct def *df; register t_def *df;
register struct scopelist *sc = vis; register struct scopelist *sc = vis;
while (sc) { while (sc) {

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

@ -37,11 +37,12 @@ char *ProgName;
char **DEFPATH; char **DEFPATH;
int nDEF, mDEF; int nDEF, mDEF;
int pass_1; int pass_1;
struct def *Defined; t_def *Defined;
extern int err_occurred; extern int err_occurred;
extern int Roption; extern int Roption;
extern int fp_used; /* set if floating point used */ extern int fp_used; /* set if floating point used */
struct node *EmptyStatement; static t_node _emptystat = { NULLNODE, NULLNODE, Stat, NULLTYPE, { ';' }};
t_node *EmptyStatement = &_emptystat;
main(argc, argv) main(argc, argv)
register char **argv; register char **argv;
@ -88,8 +89,6 @@ Compile(src, dst)
InitScope(); InitScope();
InitTypes(); InitTypes();
AddStandards(); AddStandards();
EmptyStatement = dot2leaf(Stat);
EmptyStatement->nd_symb = ';';
Roption = options['R']; Roption = options['R'];
#ifdef DEBUG #ifdef DEBUG
if (options['l']) { if (options['l']) {
@ -124,7 +123,7 @@ Compile(src, dst)
#ifdef DEBUG #ifdef DEBUG
LexScan() LexScan()
{ {
register struct token *tkp = &dot; register t_token *tkp = &dot;
extern char *symbol2str(); extern char *symbol2str();
while (LLlex() > 0) { while (LLlex() > 0) {
@ -184,13 +183,13 @@ static struct stdproc {
{ 0, 0 } { 0, 0 }
}; };
extern struct def *Enter(); extern t_def *Enter();
AddStandards() AddStandards()
{ {
register struct def *df; register t_def *df;
register struct stdproc *p; register struct stdproc *p;
static struct token nilconst = { INTEGER, 0}; static t_token nilconst = { INTEGER, 0};
for (p = stdproc; p->st_nam != 0; p++) { for (p = stdproc; p->st_nam != 0; p++) {
Enter(p->st_nam, D_PROCEDURE, std_type, p->st_con); Enter(p->st_nam, D_PROCEDURE, std_type, p->st_con);

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

@ -20,7 +20,7 @@
#include "node.h" #include "node.h"
match_id(id1, id2) match_id(id1, id2)
register struct idf *id1, *id2; register t_idf *id1, *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
@ -34,14 +34,14 @@ match_id(id1, id2)
} }
} }
struct idf * t_idf *
gen_anon_idf() gen_anon_idf()
{ {
/* 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.
*/ */
static int name_cnt; static int name_cnt;
char buff[100]; char buff[512];
char *sprint(); char *sprint();
sprint(buff, "#%d in %s, line %u", sprint(buff, "#%d in %s, line %u",
@ -51,7 +51,7 @@ gen_anon_idf()
not_declared(what, id, where) not_declared(what, id, where)
char *what, *where; char *what, *where;
register struct node *id; register t_node *id;
{ {
/* 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

6
lang/m2/comp/node.H
View file

@ -41,11 +41,13 @@ struct node {
#define nd_REL nd_token.TOK_REL #define nd_REL nd_token.TOK_REL
}; };
typedef struct node t_node;
/* ALLOCDEF "node" 50 */ /* ALLOCDEF "node" 50 */
extern struct node *MkNode(), *MkLeaf(), *dot2node(), *dot2leaf(); extern t_node *MkNode(), *MkLeaf(), *dot2node(), *dot2leaf();
#define NULLNODE ((struct node *) 0) #define NULLNODE ((t_node *) 0)
#define HASSELECTORS 002 #define HASSELECTORS 002
#define VARIABLE 004 #define VARIABLE 004

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

@ -21,14 +21,14 @@
#include "type.h" #include "type.h"
#include "node.h" #include "node.h"
struct node * t_node *
MkNode(class, left, right, token) MkNode(class, left, right, token)
struct node *left, *right; t_node *left, *right;
struct token *token; t_token *token;
{ {
/* Create a node and initialize it with the given parameters /* Create a node and initialize it with the given parameters
*/ */
register struct node *nd = new_node(); register t_node *nd = new_node();
nd->nd_left = left; nd->nd_left = left;
nd->nd_right = right; nd->nd_right = right;
@ -37,32 +37,32 @@ MkNode(class, left, right, token)
return nd; return nd;
} }
struct node * t_node *
dot2node(class, left, right) dot2node(class, left, right)
struct node *left, *right; t_node *left, *right;
{ {
return MkNode(class, left, right, &dot); return MkNode(class, left, right, &dot);
} }
struct node * t_node *
MkLeaf(class, token) MkLeaf(class, token)
struct token *token; t_token *token;
{ {
register struct node *nd = new_node(); register t_node *nd = new_node();
nd->nd_token = *token; nd->nd_token = *token;
nd->nd_class = class; nd->nd_class = class;
return nd; return nd;
} }
struct node * t_node *
dot2leaf(class) dot2leaf(class)
{ {
return MkLeaf(class, &dot); return MkLeaf(class, &dot);
} }
FreeNode(nd) FreeNode(nd)
register struct node *nd; register t_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
@ -74,7 +74,7 @@ FreeNode(nd)
} }
NodeCrash(expp) NodeCrash(expp)
struct node *expp; t_node *expp;
{ {
crash("Illegal node %d", expp->nd_class); crash("Illegal node %d", expp->nd_class);
} }
@ -91,7 +91,7 @@ indnt(lvl)
} }
printnode(nd, lvl) printnode(nd, lvl)
register struct node *nd; register t_node *nd;
{ {
indnt(lvl); indnt(lvl);
print("Class: %d; Symbol: %s\n", nd->nd_class, symbol2str(nd->nd_symb)); print("Class: %d; Symbol: %s\n", nd->nd_class, symbol2str(nd->nd_symb));
@ -104,7 +104,7 @@ printnode(nd, lvl)
} }
PrNode(nd, lvl) PrNode(nd, lvl)
register struct node *nd; register t_node *nd;
{ {
if (! nd) { if (! nd) {
indnt(lvl); print("<nilnode>\n"); indnt(lvl); print("<nilnode>\n");

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

@ -48,8 +48,8 @@
ModuleDeclaration ModuleDeclaration
{ {
register struct def *df; register t_def *df;
struct node *exportlist = 0; t_node *exportlist = 0;
int qualified; int qualified;
} : } :
MODULE IDENT { df = DefineLocalModule(dot.TOK_IDF); } MODULE IDENT { df = DefineLocalModule(dot.TOK_IDF); }
@ -66,7 +66,7 @@ ModuleDeclaration
} }
; ;
priority(register struct def *df;): priority(register t_def *df;):
[ [
'[' ConstExpression(&(df->mod_priority)) ']' '[' ConstExpression(&(df->mod_priority)) ']'
{ if (!(df->mod_priority->nd_type->tp_fund & { if (!(df->mod_priority->nd_type->tp_fund &
@ -80,7 +80,7 @@ priority(register struct def *df;):
] ]
; ;
export(int *QUALflag; struct node **ExportList;): export(int *QUALflag; t_node **ExportList;):
EXPORT EXPORT
[ [
QUALIFIED QUALIFIED
@ -93,10 +93,10 @@ export(int *QUALflag; struct node **ExportList;):
import(int local;) import(int local;)
{ {
struct node *ImportList; t_node *ImportList;
register struct node *FromId = 0; register t_node *FromId = 0;
register struct def *df; register t_def *df;
extern struct def *GetDefinitionModule(); extern t_def *GetDefinitionModule();
} : } :
[ FROM [ FROM
IDENT { FromId = dot2leaf(Name); IDENT { FromId = dot2leaf(Name);
@ -120,10 +120,10 @@ import(int local;)
DefinitionModule DefinitionModule
{ {
register struct def *df; register t_def *df;
struct node *exportlist; t_node *exportlist;
int dummy; int dummy;
extern struct idf *DefId; extern t_idf *DefId;
extern int ForeignFlag; extern int ForeignFlag;
} : } :
DEFINITION DEFINITION
@ -157,7 +157,7 @@ node_warning(exportlist, W_OLDFASHIONED, "export list in definition module ignor
/* empty */ /* empty */
] ]
definition* END IDENT definition* END IDENT
{ register struct def *df1 = CurrentScope->sc_def; { register t_def *df1 = CurrentScope->sc_def;
while (df1) { while (df1) {
/* Make all definitions "QUALIFIED EXPORT" */ /* Make all definitions "QUALIFIED EXPORT" */
df1->df_flags |= D_QEXPORTED; df1->df_flags |= D_QEXPORTED;
@ -172,8 +172,8 @@ node_warning(exportlist, W_OLDFASHIONED, "export list in definition module ignor
definition definition
{ {
register struct def *df; register t_def *df;
struct def *dummy; t_def *dummy;
} : } :
CONST [ %persistent ConstantDeclaration ';' ]* CONST [ %persistent ConstantDeclaration ';' ]*
| |
@ -202,8 +202,8 @@ definition
ProgramModule ProgramModule
{ {
extern struct def *GetDefinitionModule(); extern t_def *GetDefinitionModule();
register struct def *df; register t_def *df;
} : } :
MODULE MODULE
IDENT { if (state == IMPLEMENTATION) { IDENT { if (state == IMPLEMENTATION) {

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

@ -82,7 +82,7 @@ InitScope()
STATIC STATIC
chk_proc(df) chk_proc(df)
register struct def *df; register t_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.
@ -106,18 +106,18 @@ chk_proc(df)
STATIC STATIC
chk_forw(pdf) chk_forw(pdf)
struct def **pdf; t_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 struct def *df; register t_def *df;
while (df = *pdf) { while (df = *pdf) {
if (df->df_kind == D_FORWTYPE) { if (df->df_kind == D_FORWTYPE) {
register struct def *df1 = df; register t_def *df1 = df;
register struct node *nd = df->df_forw_node; register t_node *nd = df->df_forw_node;
*pdf = df->df_nextinscope; *pdf = df->df_nextinscope;
RemoveFromIdList(df); RemoveFromIdList(df);
@ -134,7 +134,7 @@ node_error(nd, "\"%s\" is not a type", df1->df_idf->id_text);
continue; continue;
} }
else if (df->df_kind == D_FTYPE) { else if (df->df_kind == D_FTYPE) {
register struct node *nd = df->df_forw_node; register t_node *nd = df->df_forw_node;
df->df_kind = D_TYPE; df->df_kind = D_TYPE;
while (nd) { while (nd) {
@ -163,7 +163,7 @@ df->df_idf->id_text);
*/ */
register struct scopelist *ls = register struct scopelist *ls =
nextvisible(CurrVis); nextvisible(CurrVis);
struct def *df1 = df->df_nextinscope; t_def *df1 = df->df_nextinscope;
if (df->df_kind == D_FORWMODULE) { if (df->df_kind == D_FORWMODULE) {
df->for_vis->sc_next = ls; df->for_vis->sc_next = ls;
@ -180,14 +180,14 @@ df->df_idf->id_text);
} }
Reverse(pdf) Reverse(pdf)
struct def **pdf; t_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 struct def *df, *df1; register t_def *df, *df1;
#define INTERESTING D_MODULE|D_PROCEDURE|D_PROCHEAD|D_VARIABLE #define INTERESTING D_MODULE|D_PROCEDURE|D_PROCHEAD|D_VARIABLE
df = 0; df = 0;
@ -195,7 +195,7 @@ Reverse(pdf)
while (df1) { while (df1) {
if (df1->df_kind & INTERESTING) { if (df1->df_kind & INTERESTING) {
struct def *prev = df; t_def *prev = df;
df = df1; df = df1;
df1 = df1->df_nextinscope; df1 = df1->df_nextinscope;
@ -228,7 +228,7 @@ close_scope(flag)
#ifdef DEBUG #ifdef DEBUG
DumpScope(df) DumpScope(df)
register struct def *df; register t_def *df;
{ {
while (df) { while (df) {
PrDef(df); PrDef(df);

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

@ -24,12 +24,12 @@
static int loopcount = 0; /* Count nested loops */ static int loopcount = 0; /* Count nested loops */
int Roption; int Roption;
extern char options[]; extern char options[];
extern struct node *EmptyStatement; extern t_node *EmptyStatement;
} }
statement(register struct node **pnd;) statement(register t_node **pnd;)
{ {
register struct node *nd; register t_node *nd;
extern int return_occurred; extern int return_occurred;
} : } :
/* We need some method for making sure lookahead is done, so ... /* We need some method for making sure lookahead is done, so ...
@ -56,7 +56,7 @@ statement(register struct node **pnd;)
* but this gives LL(1) conflicts * but this gives LL(1) conflicts
*/ */
designator(pnd) designator(pnd)
[ { nd = dot2node(Call, *pnd, NULLNODE); [ { nd = dot2node(Stat, *pnd, NULLNODE);
nd->nd_symb = '('; nd->nd_symb = '(';
} }
ActualParameters(&(nd->nd_right))? ActualParameters(&(nd->nd_right))?
@ -123,10 +123,10 @@ ProcedureCall:
; ;
*/ */
StatementSequence(register struct node **pnd;) StatementSequence(register t_node **pnd;)
{ {
struct node *nd; t_node *nd;
register struct node *nd1; register t_node *nd1;
} : } :
statement(pnd) statement(pnd)
[ %persistent [ %persistent
@ -140,9 +140,9 @@ StatementSequence(register struct node **pnd;)
]* ]*
; ;
IfStatement(struct node **pnd;) IfStatement(t_node **pnd;)
{ {
register struct node *nd; register t_node *nd;
} : } :
IF { nd = dot2leaf(Stat); IF { nd = dot2leaf(Stat);
*pnd = nd; *pnd = nd;
@ -170,10 +170,10 @@ IfStatement(struct node **pnd;)
END END
; ;
CaseStatement(struct node **pnd;) CaseStatement(t_node **pnd;)
{ {
register struct node *nd; register t_node *nd;
struct type *tp = 0; t_type *tp = 0;
} : } :
CASE { *pnd = nd = dot2leaf(Stat); } CASE { *pnd = nd = dot2leaf(Stat); }
expression(&(nd->nd_left)) expression(&(nd->nd_left))
@ -190,7 +190,7 @@ CaseStatement(struct node **pnd;)
END END
; ;
case(struct node **pnd; struct type **ptp;) : case(t_node **pnd; t_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))
@ -201,9 +201,9 @@ case(struct node **pnd; struct type **ptp;) :
; ;
/* inline in statement; lack of space /* inline in statement; lack of space
WhileStatement(struct node **pnd;) WhileStatement(t_node **pnd;)
{ {
register struct node *nd; register t_node *nd;
}: }:
WHILE { *pnd = nd = dot2leaf(Stat); } WHILE { *pnd = nd = dot2leaf(Stat); }
expression(&(nd->nd_left)) expression(&(nd->nd_left))
@ -212,9 +212,9 @@ WhileStatement(struct node **pnd;)
END END
; ;
RepeatStatement(struct node **pnd;) RepeatStatement(t_node **pnd;)
{ {
register struct node *nd; register t_node *nd;
}: }:
REPEAT { *pnd = nd = dot2leaf(Stat); } REPEAT { *pnd = nd = dot2leaf(Stat); }
StatementSequence(&(nd->nd_left)) StatementSequence(&(nd->nd_left))
@ -223,10 +223,10 @@ RepeatStatement(struct node **pnd;)
; ;
*/ */
ForStatement(struct node **pnd;) ForStatement(t_node **pnd;)
{ {
register struct node *nd, *nd1; register t_node *nd, *nd1;
struct node *dummy; t_node *dummy;
}: }:
FOR { *pnd = nd = dot2leaf(Stat); } FOR { *pnd = nd = dot2leaf(Stat); }
IDENT { nd->nd_IDF = dot.TOK_IDF; } IDENT { nd->nd_IDF = dot.TOK_IDF; }
@ -252,16 +252,16 @@ ForStatement(struct node **pnd;)
; ;
/* inline in Statement; lack of space /* inline in Statement; lack of space
LoopStatement(struct node **pnd;): LoopStatement(t_node **pnd;):
LOOP { *pnd = dot2leaf(Stat); } LOOP { *pnd = dot2leaf(Stat); }
StatementSequence(&((*pnd)->nd_right)) StatementSequence(&((*pnd)->nd_right))
END END
; ;
*/ */
WithStatement(struct node **pnd;) WithStatement(t_node **pnd;)
{ {
register struct node *nd; register t_node *nd;
}: }:
WITH { *pnd = nd = dot2leaf(Stat); } WITH { *pnd = nd = dot2leaf(Stat); }
designator(&(nd->nd_left)) designator(&(nd->nd_left))
@ -270,10 +270,10 @@ WithStatement(struct node **pnd;)
END END
; ;
ReturnStatement(struct node **pnd;) ReturnStatement(t_node **pnd;)
{ {
register struct def *df = CurrentScope->sc_definedby; register t_def *df = CurrentScope->sc_definedby;
register struct node *nd; register t_node *nd;
} : } :
RETURN { *pnd = nd = dot2leaf(Stat); } RETURN { *pnd = nd = dot2leaf(Stat); }

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

@ -102,7 +102,7 @@ reserve(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 struct idf *p; register t_idf *p;
while (resv->tn_symbol) { while (resv->tn_symbol) {
p = str2idf(resv->tn_name, 0); p = str2idf(resv->tn_name, 0);

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

@ -99,9 +99,11 @@ struct type {
} tp_value; } tp_value;
}; };
typedef struct type t_type;
/* ALLOCDEF "type" 50 */ /* ALLOCDEF "type" 50 */
extern struct type extern t_type
*bool_type, *bool_type,
*char_type, *char_type,
*int_type, *int_type,
@ -140,7 +142,7 @@ extern arith
extern arith extern arith
align(); /* type.c */ align(); /* type.c */
struct type extern t_type
*construct_type(), *construct_type(),
*standard_type(), *standard_type(),
*set_type(), *set_type(),
@ -150,7 +152,7 @@ struct type
*qualified_type(), *qualified_type(),
*RemoveEqual(); /* All from type.c */ *RemoveEqual(); /* All from type.c */
#define NULLTYPE ((struct type *) 0) #define NULLTYPE ((t_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)

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

@ -19,6 +19,7 @@
#include <em_label.h> #include <em_label.h>
#include <em_code.h> #include <em_code.h>
#include "squeeze.h"
#include "LLlex.h" #include "LLlex.h"
#include "def.h" #include "def.h"
#include "type.h" #include "type.h"
@ -52,7 +53,7 @@ arith
double_size = SZ_DOUBLE, double_size = SZ_DOUBLE,
pointer_size = SZ_POINTER; pointer_size = SZ_POINTER;
struct type t_type
*bool_type, *bool_type,
*char_type, *char_type,
*int_type, *int_type,
@ -68,15 +69,15 @@ struct type
*std_type, *std_type,
*error_type; *error_type;
struct type * t_type *
construct_type(fund, tp) construct_type(fund, tp)
int fund; int fund;
register struct type *tp; register t_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 struct type *dtp = new_type(); register t_type *dtp = new_type();
switch (dtp->tp_fund = fund) { switch (dtp->tp_fund = fund) {
case T_PROCEDURE: case T_PROCEDURE:
@ -121,13 +122,13 @@ align(pos, al)
return pos; return pos;
} }
struct type * t_type *
standard_type(fund, align, size) standard_type(fund, align, size)
int fund; int fund;
int align; int align;
arith size; arith size;
{ {
register struct type *tp = new_type(); register t_type *tp = new_type();
tp->tp_fund = fund; tp->tp_fund = fund;
tp->tp_align = align; tp->tp_align = align;
@ -143,7 +144,7 @@ InitTypes()
{ {
/* Initialize the predefined types /* Initialize the predefined types
*/ */
register struct type *tp; register t_type *tp;
/* first, do some checking /* first, do some checking
*/ */
@ -215,7 +216,7 @@ InitTypes()
STATIC STATIC
u_small(tp, n) u_small(tp, n)
register struct type *tp; register t_type *tp;
arith n; arith n;
{ {
if (ufit(n, 1)) { if (ufit(n, 1)) {
@ -228,11 +229,11 @@ u_small(tp, n)
} }
} }
struct type * t_type *
enum_type(EnumList) enum_type(EnumList)
struct node *EnumList; t_node *EnumList;
{ {
register struct type *tp = register t_type *tp =
standard_type(T_ENUMERATION, int_align, int_size); standard_type(T_ENUMERATION, int_align, int_size);
EnterEnumList(EnumList, tp); EnterEnumList(EnumList, tp);
@ -243,11 +244,11 @@ enum_type(EnumList)
return tp; return tp;
} }
struct type * t_type *
qualified_type(nd) qualified_type(nd)
register struct node *nd; register t_node *nd;
{ {
register struct def *df; register t_def *df;
if (ChkDesignator(nd)) { if (ChkDesignator(nd)) {
if (nd->nd_class != Def) { if (nd->nd_class != Def) {
@ -276,7 +277,7 @@ node_error(nd,"identifier \"%s\" is not a type", df->df_idf->id_text);
} }
chk_basesubrange(tp, base) chk_basesubrange(tp, base)
register struct type *tp, *base; register t_type *tp, *base;
{ {
/* A subrange had a specified base. Check that the bases conform. /* A subrange had a specified base. Check that the bases conform.
*/ */
@ -330,17 +331,17 @@ chk_bounds(l1, l2, fund)
); );
} }
struct type * t_type *
subr_type(lb, ub) subr_type(lb, ub)
register struct node *lb; register t_node *lb;
struct node *ub; t_node *ub;
{ {
/* 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 checks
*/ */
register struct type *tp = BaseType(lb->nd_type); register t_type *tp = BaseType(lb->nd_type);
register struct type *res; register t_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,
@ -389,13 +390,13 @@ subr_type(lb, ub)
return res; return res;
} }
struct type * t_type *
proc_type(result_type, parameters, n_bytes_params) proc_type(result_type, parameters, n_bytes_params)
struct type *result_type; t_type *result_type;
struct paramlist *parameters; struct paramlist *parameters;
arith n_bytes_params; arith n_bytes_params;
{ {
register struct type *tp = construct_type(T_PROCEDURE, result_type); register t_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;
@ -403,7 +404,7 @@ proc_type(result_type, parameters, n_bytes_params)
} }
genrck(tp) genrck(tp)
register struct type *tp; register t_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.
@ -426,12 +427,12 @@ genrck(tp)
C_rom_cst(lb); C_rom_cst(lb);
C_rom_cst(ub); C_rom_cst(ub);
} }
C_lae_dlb(ol, (arith) 0); c_lae_dlb(ol);
C_rck(word_size); C_rck(word_size);
} }
getbounds(tp, plo, phi) getbounds(tp, plo, phi)
register struct type *tp; register t_type *tp;
arith *plo, *phi; arith *plo, *phi;
{ {
/* Get the bounds of a bounded type /* Get the bounds of a bounded type
@ -449,9 +450,9 @@ getbounds(tp, plo, phi)
} }
} }
struct type * t_type *
set_type(tp) set_type(tp)
register struct type *tp; register t_type *tp;
{ {
/* 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
@ -477,7 +478,7 @@ set_type(tp)
arith arith
ArrayElSize(tp) ArrayElSize(tp)
register struct type *tp; register t_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,
@ -497,12 +498,12 @@ ArrayElSize(tp)
} }
ArraySizes(tp) ArraySizes(tp)
register struct type *tp; register t_type *tp;
{ {
/* Assign sizes to an array type, and check index type /* Assign sizes to an array type, and check index type
*/ */
register struct type *index_type = IndexType(tp); register t_type *index_type = IndexType(tp);
register struct type *elem_type = tp->arr_elem; register t_type *elem_type = tp->arr_elem;
arith lo, hi, diff; arith lo, hi, diff;
tp->arr_elsize = ArrayElSize(elem_type); tp->arr_elsize = ArrayElSize(elem_type);
@ -531,7 +532,7 @@ ArraySizes(tp)
} }
FreeType(tp) FreeType(tp)
register struct type *tp; register t_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
@ -553,9 +554,9 @@ FreeType(tp)
} }
DeclareType(nd, df, tp) DeclareType(nd, df, tp)
register struct def *df; register t_def *df;
register struct type *tp; register t_type *tp;
struct node *nd; t_node *nd;
{ {
/* 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".
@ -563,7 +564,7 @@ DeclareType(nd, df, 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 struct type *df_tp = df->df_type; register t_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))) {
@ -586,9 +587,9 @@ DeclareType(nd, df, tp)
else df->df_type = tp; else df->df_type = tp;
} }
struct type * t_type *
RemoveEqual(tpx) RemoveEqual(tpx)
register struct type *tpx; register t_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;
@ -597,29 +598,26 @@ RemoveEqual(tpx)
int int
type_or_forward(ptp) type_or_forward(ptp)
struct type **ptp; t_type **ptp;
{ {
/* 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 struct node *nd; register t_node *nd;
register struct def *df, *df1; register t_def *df, *df1;
if ((df1 = lookup(dot.TOK_IDF, CurrentScope, 1))) { if ((df1 = lookup(dot.TOK_IDF, CurrentScope, 1))) {
/* Either a Module or a Type, but in both cases defined /* Either a Module or a Type, but in both cases defined
in this scope, so this is the correct identification in this scope, so this is the correct identification
*/ */
if (df1->df_kind == D_FORWTYPE) { if (df1->df_kind == D_FORWTYPE) {
nd = new_node(); nd = dot2node(NULLNODE, df1->df_forw_node, 0);
nd->nd_token = dot;
nd->nd_right = df1->df_forw_node;
df1->df_forw_node = nd; df1->df_forw_node = nd;
nd->nd_type = *ptp; nd->nd_type = *ptp;
} }
return 1; return 1;
} }
nd = new_node(); nd = dot2leaf(0);
nd->nd_token = dot;
if ((df1 = lookfor(nd, CurrVis, 0))->df_kind == D_MODULE) { if ((df1 = lookfor(nd, CurrVis, 0))->df_kind == D_MODULE) {
/* A Modulename in one of the enclosing scopes. /* A Modulename in one of the enclosing scopes.
It is not clear from the language definition that It is not clear from the language definition that
@ -629,7 +627,7 @@ type_or_forward(ptp)
one token. one token.
??? ???
*/ */
free_node(nd); FreeNode(nd);
return 1; return 1;
} }
/* Enter a forward reference into a list belonging to the /* Enter a forward reference into a list belonging to the
@ -641,7 +639,7 @@ type_or_forward(ptp)
if (df->df_kind == D_TYPE) { if (df->df_kind == D_TYPE) {
(*ptp)->tp_next = df->df_type; (*ptp)->tp_next = df->df_type;
free_node(nd); FreeNode(nd);
return 0; return 0;
} }
nd->nd_type = *ptp; nd->nd_type = *ptp;
@ -679,7 +677,7 @@ lcm(m, n)
#ifdef DEBUG #ifdef DEBUG
DumpType(tp) DumpType(tp)
register struct type *tp; register t_type *tp;
{ {
if (!tp) return; if (!tp) return;

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

@ -29,7 +29,7 @@ extern char *sprint();
int int
TstTypeEquiv(tp1, tp2) TstTypeEquiv(tp1, tp2)
struct type *tp1, *tp2; t_type *tp1, *tp2;
{ {
/* test if two types are equivalent. /* test if two types are equivalent.
*/ */
@ -43,7 +43,7 @@ TstTypeEquiv(tp1, tp2)
int int
TstParEquiv(tp1, tp2) TstParEquiv(tp1, tp2)
register struct type *tp1, *tp2; register t_type *tp1, *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,7 +66,7 @@ TstParEquiv(tp1, tp2)
int int
TstProcEquiv(tp1, tp2) TstProcEquiv(tp1, tp2)
struct type *tp1, *tp2; t_type *tp1, *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
@ -98,7 +98,7 @@ TstProcEquiv(tp1, tp2)
int int
TstCompat(tp1, tp2) TstCompat(tp1, tp2)
register struct type *tp1, *tp2; register t_type *tp1, *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".
@ -110,7 +110,7 @@ TstCompat(tp1, tp2)
tp2 = BaseType(tp2); tp2 = BaseType(tp2);
if (tp2 != intorcard_type && if (tp2 != intorcard_type &&
(tp1 == intorcard_type || tp1 == address_type)) { (tp1 == intorcard_type || tp1 == address_type)) {
struct type *tmp = tp2; t_type *tmp = tp2;
tp2 = tp1; tp2 = tp1;
tp1 = tmp; tp1 = tmp;
@ -132,12 +132,12 @@ TstCompat(tp1, tp2)
int int
TstAssCompat(tp1, tp2) TstAssCompat(tp1, tp2)
register struct type *tp1, *tp2; register t_type *tp1, *tp2;
{ {
/* Test if two types are assignment compatible. /* Test if two types are assignment compatible.
See Def 9.1. See Def 9.1.
*/ */
register struct type *tp; register t_type *tp;
if (TstCompat(tp1, tp2)) return 1; if (TstCompat(tp1, tp2)) return 1;
@ -179,9 +179,9 @@ TstAssCompat(tp1, tp2)
int int
TstParCompat(parno, formaltype, VARflag, nd, edf) TstParCompat(parno, formaltype, VARflag, nd, edf)
register struct type *formaltype; register t_type *formaltype;
struct node **nd; t_node **nd;
struct def *edf; t_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
@ -190,7 +190,7 @@ TstParCompat(parno, formaltype, VARflag, nd, edf)
may do too. may do too.
Or: a WORD may do. Or: a WORD may do.
*/ */
register struct type *actualtype = (*nd)->nd_type; register t_type *actualtype = (*nd)->nd_type;
char ebuf[256]; char ebuf[256];
char ebuf1[256]; char ebuf1[256];
@ -258,8 +258,8 @@ TstParCompat(parno, formaltype, VARflag, nd, edf)
} }
CompatCheck(nd, tp, message, fc) CompatCheck(nd, tp, message, fc)
struct node **nd; t_node **nd;
struct type *tp; t_type *tp;
char *message; char *message;
int (*fc)(); int (*fc)();
{ {
@ -274,8 +274,8 @@ CompatCheck(nd, tp, message, fc)
} }
ChkAssCompat(nd, tp, message) ChkAssCompat(nd, tp, message)
struct node **nd; t_node **nd;
struct type *tp; t_type *tp;
char *message; char *message;
{ {
/* Check assignment compatibility of node "nd" with type "tp". /* Check assignment compatibility of node "nd" with type "tp".
@ -286,8 +286,8 @@ ChkAssCompat(nd, tp, message)
} }
ChkCompat(nd, tp, message) ChkCompat(nd, tp, message)
struct node **nd; t_node **nd;
struct type *tp; t_type *tp;
char *message; char *message;
{ {
/* Check compatibility of node "nd" with type "tp". /* Check compatibility of node "nd" with type "tp".

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

@ -23,6 +23,7 @@
#include <assert.h> #include <assert.h>
#include <alloc.h> #include <alloc.h>
#include "squeeze.h"
#include "LLlex.h" #include "LLlex.h"
#include "def.h" #include "def.h"
#include "type.h" #include "type.h"
@ -37,19 +38,32 @@
#include "walk.h" #include "walk.h"
#include "warning.h" #include "warning.h"
extern arith NewPtr(); extern arith NewPtr();
extern arith NewInt(); extern arith NewInt();
extern int proclevel; extern int proclevel;
label text_label; label text_label;
label data_label = 1; label data_label = 1;
static struct type *func_type; static t_type *func_type;
struct withdesig *WithDesigs; struct withdesig *WithDesigs;
struct node *Modules; t_node *Modules;
static struct node *priority; static arith priority;
#define NO_EXIT_LABEL ((label) 0) #define NO_EXIT_LABEL ((label) 0)
#define RETURN_LABEL ((label) 1) #define RETURN_LABEL ((label) 1)
LblWalkNode(lbl, nd, exit)
label lbl, exit;
register t_node *nd;
{
/* Generate code for node "nd", after generating instruction
label "lbl". "exit" is the exit label for the closest
enclosing LOOP.
*/
C_df_ilb(lbl);
WalkNode(nd, exit);
}
STATIC STATIC
DoPriority() DoPriority()
{ {
@ -57,10 +71,8 @@ DoPriority()
the runtime system the runtime system
*/ */
register struct node *p; if (priority) {
C_loc(priority);
if (p = priority) {
C_loc(p->nd_INT);
C_cal("_stackprio"); C_cal("_stackprio");
C_asp(word_size); C_asp(word_size);
} }
@ -92,7 +104,7 @@ DoProfil()
} }
WalkModule(module) WalkModule(module)
register struct def *module; register t_def *module;
{ {
/* Walk through a module, and all its local definitions. /* Walk through a module, and all its local definitions.
Also generate code for its body. Also generate code for its body.
@ -102,7 +114,7 @@ WalkModule(module)
struct scopelist *savevis = CurrVis; struct scopelist *savevis = CurrVis;
CurrVis = module->mod_vis; CurrVis = module->mod_vis;
priority = module->mod_priority; priority = module->mod_priority ? module->mod_priority->nd_INT : 0;
sc = CurrentScope; sc = CurrentScope;
/* Walk through it's local definitions /* Walk through it's local definitions
@ -124,7 +136,7 @@ WalkModule(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 struct node *nd = Modules; register t_node *nd = Modules;
if (state == IMPLEMENTATION) { if (state == IMPLEMENTATION) {
/* We don't actually prevent recursive calls, /* We don't actually prevent recursive calls,
@ -159,14 +171,14 @@ WalkModule(module)
} }
WalkProcedure(procedure) WalkProcedure(procedure)
register struct def *procedure; register t_def *procedure;
{ {
/* 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.
*/ */
struct scopelist *savevis = CurrVis; struct scopelist *savevis = CurrVis;
register struct scope *sc = procedure->prc_vis->sc_scope; register struct scope *sc = procedure->prc_vis->sc_scope;
register struct type *tp; register t_type *tp;
register struct paramlist *param; register struct paramlist *param;
label func_res_label = 0; label func_res_label = 0;
arith StackAdjustment = 0; arith StackAdjustment = 0;
@ -276,7 +288,7 @@ WalkProcedure(procedure)
WalkNode(procedure->prc_body, NO_EXIT_LABEL); WalkNode(procedure->prc_body, NO_EXIT_LABEL);
DO_DEBUG(options['X'], PrNode(procedure->prc_body, 0)); DO_DEBUG(options['X'], PrNode(procedure->prc_body, 0));
if (func_res_size) { if (func_res_size) {
C_loc((arith) M2_NORESULT); c_loc(M2_NORESULT);
C_trp(); C_trp();
C_asp(-func_res_size); C_asp(-func_res_size);
} }
@ -285,7 +297,7 @@ WalkProcedure(procedure)
/* Fill the data area reserved for the function result /* Fill the data area reserved for the function result
with the result with the result
*/ */
C_lae_dlb(func_res_label, (arith) 0); c_lae_dlb(func_res_label);
C_sti(func_res_size); C_sti(func_res_size);
if (StackAdjustment) { if (StackAdjustment) {
/* Remove copies of conformant arrays /* Remove copies of conformant arrays
@ -293,7 +305,7 @@ WalkProcedure(procedure)
C_lol(StackAdjustment); C_lol(StackAdjustment);
C_str((arith) 1); C_str((arith) 1);
} }
C_lae_dlb(func_res_label, (arith) 0); c_lae_dlb(func_res_label);
func_res_size = pointer_size; func_res_size = pointer_size;
} }
else if (StackAdjustment) { else if (StackAdjustment) {
@ -323,7 +335,7 @@ WalkProcedure(procedure)
} }
WalkDef(df) WalkDef(df)
register struct def *df; register t_def *df;
{ {
/* Walk through a list of definitions /* Walk through a list of definitions
*/ */
@ -352,7 +364,7 @@ WalkDef(df)
} }
MkCalls(df) MkCalls(df)
register struct def *df; register t_def *df;
{ {
/* Generate calls to initialization routines of modules /* Generate calls to initialization routines of modules
*/ */
@ -367,7 +379,7 @@ MkCalls(df)
} }
WalkLink(nd, exit_label) WalkLink(nd, exit_label)
register struct node *nd; register t_node *nd;
label exit_label; label exit_label;
{ {
/* Walk node "nd", which is a link. /* Walk node "nd", which is a link.
@ -381,44 +393,39 @@ WalkLink(nd, exit_label)
WalkNode(nd, exit_label); WalkNode(nd, exit_label);
} }
WalkCall(nd)
register struct node *nd;
{
assert(nd->nd_class == Call);
if (! options['L']) C_lin((arith) nd->nd_lineno);
if (ChkCall(nd)) {
if (nd->nd_type != 0) {
node_error(nd, "procedure call expected");
return;
}
CodeCall(nd);
}
}
STATIC STATIC
ForLoopVarExpr(nd) ForLoopVarExpr(nd)
register struct node *nd; register t_node *nd;
{ {
register struct type *tp = nd->nd_type; register t_type *tp = nd->nd_type;
CodePExpr(nd); CodePExpr(nd);
CodeCoercion(tp, BaseType(tp)); CodeCoercion(tp, BaseType(tp));
} }
WalkStat(nd, exit_label) WalkStat(nd, exit_label)
register struct node *nd; register t_node *nd;
label exit_label; label exit_label;
{ {
/* Walk through a statement, generating code for it. /* Walk through a statement, generating code for it.
*/ */
register struct node *left = nd->nd_left; register t_node *left = nd->nd_left;
register struct node *right = nd->nd_right; register t_node *right = nd->nd_right;
assert(nd->nd_class == Stat); assert(nd->nd_class == Stat);
if (! options['L'] && nd->nd_lineno) C_lin((arith) nd->nd_lineno); if (! options['L'] && nd->nd_lineno) C_lin((arith) nd->nd_lineno);
switch(nd->nd_symb) { switch(nd->nd_symb) {
case '(':
if (ChkCall(nd)) {
if (nd->nd_type != 0) {
node_error(nd, "procedure call expected");
break;
}
CodeCall(nd);
}
break;
case ';': case ';':
break; break;
@ -431,15 +438,13 @@ WalkStat(nd, exit_label)
ExpectBool(left, l3, l1); ExpectBool(left, l3, l1);
assert(right->nd_symb == THEN); assert(right->nd_symb == THEN);
C_df_ilb(l3); LblWalkNode(l3, right->nd_left, exit_label);
WalkNode(right->nd_left, exit_label);
if (right->nd_right) { /* ELSE part */ if (right->nd_right) { /* ELSE part */
label l2 = ++text_label; label l2 = ++text_label;
C_bra(l2); C_bra(l2);
C_df_ilb(l1); LblWalkNode(l1, right->nd_right, exit_label);
WalkNode(right->nd_right, exit_label);
l1 = l2; l1 = l2;
} }
C_df_ilb(l1); C_df_ilb(l1);
@ -457,8 +462,7 @@ WalkStat(nd, exit_label)
C_df_ilb(loop); C_df_ilb(loop);
ExpectBool(left, dummy, exit); ExpectBool(left, dummy, exit);
C_df_ilb(dummy); LblWalkNode(dummy, right, exit_label);
WalkNode(right, exit_label);
C_bra(loop); C_bra(loop);
C_df_ilb(exit); C_df_ilb(exit);
break; break;
@ -467,8 +471,7 @@ WalkStat(nd, exit_label)
case REPEAT: case REPEAT:
{ label loop = ++text_label, exit = ++text_label; { label loop = ++text_label, exit = ++text_label;
C_df_ilb(loop); LblWalkNode(loop, left, exit_label);
WalkNode(left, exit_label);
ExpectBool(right, exit, loop); ExpectBool(right, exit, loop);
C_df_ilb(exit); C_df_ilb(exit);
break; break;
@ -477,8 +480,7 @@ WalkStat(nd, exit_label)
case LOOP: case LOOP:
{ label loop = ++text_label, exit = ++text_label; { label loop = ++text_label, exit = ++text_label;
C_df_ilb(loop); LblWalkNode(loop, right, exit);
WalkNode(right, exit);
C_bra(loop); C_bra(loop);
C_df_ilb(exit); C_df_ilb(exit);
break; break;
@ -488,13 +490,13 @@ WalkStat(nd, exit_label)
{ {
arith tmp = NewInt(); arith tmp = NewInt();
arith tmp2; arith tmp2;
register struct node *fnd; register t_node *fnd;
int good_forvar; int good_forvar;
label l1 = ++text_label; label l1 = ++text_label;
label l2 = ++text_label; label l2 = ++text_label;
int uns = 0; int uns = 0;
arith stepsize; arith stepsize;
struct type *bstp; t_type *bstp;
good_forvar = DoForInit(nd); good_forvar = DoForInit(nd);
if ((stepsize = left->nd_INT) == 0) { if ((stepsize = left->nd_INT) == 0) {
@ -551,7 +553,7 @@ WalkStat(nd, exit_label)
C_lol(tmp); C_lol(tmp);
C_zeq(l2); C_zeq(l2);
C_lol(tmp); C_lol(tmp);
C_loc((arith) 1); c_loc(1);
C_sbu(int_size); C_sbu(int_size);
C_stl(tmp); C_stl(tmp);
C_loc(left->nd_INT); C_loc(left->nd_INT);
@ -575,7 +577,7 @@ WalkStat(nd, exit_label)
{ {
struct scopelist link; struct scopelist link;
struct withdesig wds; struct withdesig wds;
struct desig ds; t_desig ds;
if (! WalkDesignator(left, &ds)) break; if (! WalkDesignator(left, &ds)) break;
if (left->nd_type->tp_fund != T_RECORD) { if (left->nd_type->tp_fund != T_RECORD) {
@ -640,7 +642,7 @@ extern int NodeCrash();
STATIC STATIC
WalkOption(nd) WalkOption(nd)
struct node *nd; t_node *nd;
{ {
/* Set option indicated by node "nd" /* Set option indicated by node "nd"
*/ */
@ -654,7 +656,7 @@ int (*WalkTable[])() = {
NodeCrash, NodeCrash,
NodeCrash, NodeCrash,
NodeCrash, NodeCrash,
WalkCall, NodeCrash,
NodeCrash, NodeCrash,
NodeCrash, NodeCrash,
NodeCrash, NodeCrash,
@ -665,13 +667,13 @@ int (*WalkTable[])() = {
}; };
ExpectBool(nd, true_label, false_label) ExpectBool(nd, true_label, false_label)
register struct node *nd; register t_node *nd;
label true_label, false_label; label true_label, false_label;
{ {
/* "nd" must indicate a boolean expression. Check this and /* "nd" must indicate a boolean expression. Check this and
generate code to evaluate the expression. generate code to evaluate the expression.
*/ */
register struct desig *ds = new_desig(); register t_desig *ds = new_desig();
if (ChkExpression(nd)) { if (ChkExpression(nd)) {
if (nd->nd_type != bool_type && nd->nd_type != error_type) { if (nd->nd_type != bool_type && nd->nd_type != error_type) {
@ -685,25 +687,25 @@ ExpectBool(nd, true_label, false_label)
int int
WalkDesignator(nd, ds) WalkDesignator(nd, ds)
struct node *nd; t_node *nd;
struct desig *ds; t_desig *ds;
{ {
/* Check designator and generate code for it /* Check designator and generate code for it
*/ */
if (! ChkVariable(nd)) return 0; if (! ChkVariable(nd)) return 0;
clear((char *) ds, sizeof(struct desig)); clear((char *) ds, sizeof(t_desig));
CodeDesig(nd, ds); CodeDesig(nd, ds);
return 1; return 1;
} }
DoForInit(nd) DoForInit(nd)
register struct node *nd; register t_node *nd;
{ {
register struct node *left = nd->nd_left; register t_node *left = nd->nd_left;
register struct def *df; register t_def *df;
struct type *tpl, *tpr; t_type *tpl, *tpr;
nd->nd_left = nd->nd_right = 0; nd->nd_left = nd->nd_right = 0;
nd->nd_class = Name; nd->nd_class = Name;
@ -761,16 +763,16 @@ node_warning(nd, W_OLDFASHIONED, "compatibility required in FOR statement");
} }
DoAssign(left, right) DoAssign(left, right)
register struct node *left; register t_node *left;
struct node *right; t_node *right;
{ {
/* 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!
*/ */
register struct desig *dsr; register t_desig *dsr;
register struct type *tp; register t_type *tp;
if (! (ChkExpression(right) & ChkVariable(left))) return; if (! (ChkExpression(right) & ChkVariable(left))) return;
tp = left->nd_type; tp = left->nd_type;
@ -797,9 +799,9 @@ DoAssign(left, right)
} }
RegisterMessages(df) RegisterMessages(df)
register struct def *df; register t_def *df;
{ {
register struct type *tp; register t_type *tp;
arith sz; arith sz;
int regtype = -1; int regtype = -1;

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

@ -18,3 +18,8 @@ extern int (*WalkTable[])();
extern label text_label; extern label text_label;
extern label data_label; extern label data_label;
#ifndef SQUEEZE
#define c_loc(x) C_loc((arith) (x))
#define c_lae_dlb(x) C_lae_dlb(x,(arith) 0)
#endif