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

New version with different parameter passing mechanism and some

Browse source 
minor fixes
This commit is contained in:
ceriel 1989-03-20 13:32:06 +00:00
parent 346bc839a3
commit f9b6acf1dc
15 changed files with 197 additions and 105 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -152,9 +152,11 @@ GetString(upto)
}
}
str->s_length = p - str->s_str;
*p = '\0';
str->s_str = Realloc(str->s_str,
(unsigned)((str->s_length+(int)word_size) & ~((int)word_size-1)));
len = (str->s_length+(int)word_size) & ~((int)word_size-1);
while (p - str->s_str < len) {
*p++ = '\0';
}
str->s_str = Realloc(str->s_str, (unsigned) len);
if (str->s_length == 0) str->s_length = 1;
/* ??? string length at least 1 ??? */
return str;

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

@ -1 +1 @@
static char Version[] = "ACK Modula-2 compiler Version 0.47";
static char Version[] = "ACK Modula-2 compiler Version 0.48";

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

@ -77,7 +77,8 @@ compact(nr, low, up)
diff / nr <= (DENSITY - 1));
}
CaseCode(nd, exitlabel)
int
CaseCode(nd, exitlabel, end_reached)
t_node *nd;
label exitlabel;
{
@ -91,6 +92,7 @@ CaseCode(nd, exitlabel)
register struct case_entry *ce;
register arith val;
label CaseDescrLab;
int rval;
assert(pnode->nd_class == Stat && pnode->nd_symb == CASE);
@ -109,15 +111,12 @@ CaseCode(nd, exitlabel)
/* non-empty case
*/
pnode->nd_lab = ++text_label;
if (! AddCases(sh, /* to descriptor */
pnode->nd_left->nd_left,
/* of case labels */
pnode->nd_lab
/* and code label */
)) {
FreeSh(sh);
return;
}
AddCases(sh, /* to descriptor */
pnode->nd_left->nd_left,
/* of case labels */
pnode->nd_lab
/* and code label */
);
}
}
else {
@ -135,8 +134,6 @@ CaseCode(nd, exitlabel)
*/
if (! (sh->sh_type->tp_fund & T_DISCRETE)) {
node_error(nd, "illegal type in CASE-expression");
FreeSh(sh);
return;
}
}
@ -184,12 +181,13 @@ CaseCode(nd, exitlabel)
/* Now generate code for the cases
*/
pnode = nd;
rval = 0;
while (pnode = pnode->nd_right) {
if (pnode->nd_class == Link && pnode->nd_symb == '|') {
if (pnode->nd_left) {
LblWalkNode(pnode->nd_lab,
rval |= LblWalkNode(pnode->nd_lab,
pnode->nd_left->nd_right,
exitlabel);
exitlabel, end_reached);
C_bra(sh->sh_break);
}
}
@ -198,13 +196,15 @@ CaseCode(nd, exitlabel)
*/
assert(sh->sh_default != 0);
LblWalkNode(sh->sh_default, pnode, exitlabel);
rval |= LblWalkNode(sh->sh_default,
pnode, exitlabel, end_reached);
break;
}
}
def_ilb(sh->sh_break);
FreeSh(sh);
return rval;
}
FreeSh(sh)
@ -241,22 +241,23 @@ AddCases(sh, node, lbl)
node->nd_type = node->nd_left->nd_type;
node->nd_INT = node->nd_left->nd_INT;
for (;;) {
if (! AddOneCase(sh, node, lbl)) return 0;
AddOneCase(sh, node, lbl);
if (node->nd_INT == node->nd_right->nd_INT) {
break;
}
node->nd_INT++;
}
return 1;
return;
}
assert(node->nd_symb == ',');
return AddCases(sh, node->nd_left, lbl) &&
AddCases(sh, node->nd_right, lbl);
AddCases(sh, node->nd_left, lbl);
AddCases(sh, node->nd_right, lbl);
return;
}
assert(node->nd_class == Value);
return AddOneCase(sh, node, lbl);
AddOneCase(sh, node, lbl);
}
AddOneCase(sh, node, lbl)
@ -271,8 +272,6 @@ AddOneCase(sh, node, lbl)
ce->ce_label = lbl;
ce->ce_value = node->nd_INT;
if (! ChkCompat(&node, sh->sh_type, "case")) {
free_case_entry(ce);
return 0;
}
if (sh->sh_entries == 0) {
/* first case entry
@ -311,7 +310,6 @@ AddOneCase(sh, node, lbl)
if (c1->ce_value == ce->ce_value) {
node_error(node, "multiple case entry for value %ld", ce->ce_value);
free_case_entry(ce);
return 0;
}
if (c2) {
ce->ce_next = c2->ce_next;
@ -330,5 +328,4 @@ node_error(node, "multiple case entry for value %ld", ce->ce_value);
}
(sh->sh_nrofentries)++;
}
return 1;
}

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

@ -207,23 +207,24 @@ ChkArr(expp, flags)
"index type");
}
#ifdef DEBUG
/*ARGSUSED*/
STATIC int
ChkValue(expp)
t_node *expp;
{
#ifdef DEBUG
switch(expp->nd_symb) {
case REAL:
case STRING:
case INTEGER:
return 1;
break;
default:
crash("(ChkValue)");
}
/*NOTREACHED*/
}
#endif
return 1;
}
STATIC int
ChkLinkOrName(expp, flags)
@ -430,7 +431,6 @@ MkSet(size)
{
register arith *s;
size = (size / (int) word_size + 1) * sizeof(arith);
s = (arith *) Malloc(size);
clear((char *) s , size);
s++;
@ -492,7 +492,7 @@ ChkSet(expp)
First allocate room for the set.
*/
expp->nd_set = MkSet((unsigned)(tp->tp_size));
expp->nd_set = MkSet(tp->set_sz);
/* Now check the elements, one by one
*/
@ -1163,7 +1163,7 @@ ChkStandard(expp)
}
left = getvariable(&arg,
edf,
edf->df_value.df_stdname == S_NEW ? D_DEFINED : D_USED);
D_USED|D_DEFINED);
expp->nd_type = 0;
if (! left) return 0;
if (! (left->nd_type->tp_fund == T_POINTER)) {
@ -1395,19 +1395,17 @@ no_desig(expp)
}
STATIC int
done_before()
add_flags(expp, flags)
t_node *expp;
{
expp->nd_def->df_flags |= flags;
return 1;
}
extern int NodeCrash();
int (*ExprChkTable[])() = {
#ifdef DEBUG
ChkValue,
#else
done_before,
#endif
ChkArr,
ChkBinOper,
ChkUnOper,
@ -1416,7 +1414,7 @@ int (*ExprChkTable[])() = {
ChkExLinkOrName,
NodeCrash,
ChkSet,
done_before,
add_flags,
NodeCrash,
ChkExLinkOrName,
};
@ -1431,7 +1429,7 @@ int (*DesigChkTable[])() = {
ChkLinkOrName,
NodeCrash,
no_desig,
done_before,
add_flags,
NodeCrash,
ChkLinkOrName,
};

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

@ -417,6 +417,8 @@ CodeParameters(param, arg)
C_loc(left_type->arr_high - left_type->arr_low);
}
c_loc(0);
}
if (IsConformantArray(tp) || IsVarParam(param) || IsBigParamTp(tp)) {
if (left->nd_symb == STRING) {
CodeString(left);
}
@ -438,10 +440,6 @@ CodeParameters(param, arg)
}
return;
}
if (IsVarParam(param)) {
CodeDAddress(left, 1);
return;
}
if (left_type->tp_fund == T_STRING) {
CodePString(left, tp);
return;

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

@ -371,6 +371,10 @@ cstset(expp)
setsize = (unsigned) (expp->nd_right->nd_type->tp_size) / (unsigned) word_size;
if (expp->nd_symb == IN) {
/* The setsize must fit in an unsigned, as it is
allocated with Malloc, so we can do the arithmetic
in an unsigned too.
*/
unsigned i;
assert(expp->nd_left->nd_class == Value);
@ -378,6 +382,10 @@ cstset(expp)
expp->nd_left->nd_INT -= expp->nd_right->nd_type->set_low;
i = expp->nd_left->nd_INT;
expp->nd_class = Value;
/* Careful here; use expp->nd_left->nd_INT to see if
it falls in the range of the set. Do not use i
for this, as i may be truncated.
*/
expp->nd_INT = (expp->nd_left->nd_INT >= 0 &&
expp->nd_left->nd_INT < setsize * wrd_bits &&
(set2[i / wrd_bits] & (1 << (i % wrd_bits))));
@ -393,7 +401,7 @@ cstset(expp)
case '-': /* Set difference */
case '*': /* Set intersection */
case '/': /* Symmetric set difference */
expp->nd_set = resultset = MkSet(setsize * (unsigned) word_size);
expp->nd_set = resultset = MkSet(expp->nd_type->set_sz);
for (j = 0; j < setsize; j++) {
switch(expp->nd_symb) {
case '+':

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

@ -402,7 +402,7 @@ CaseLabels(t_type **ptp; register t_node **pnd;)
{
if (*ptp != 0) {
t_type *tp = intorcard(*ptp,
BaseType((*pnd)->nd_type), 0);
BaseType((*pnd)->nd_type));
if (tp) *ptp = tp;
ChkCompat(pnd, *ptp, "case label");
}

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

@ -55,6 +55,7 @@ typedef struct desig t_desig;
struct withdesig {
struct withdesig *w_next;
int w_flags; /* D_USED|D_DEFINED */
struct scope *w_scope; /* scope in which fields of this record
reside
*/

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

@ -514,6 +514,7 @@ CodeFieldDesig(df, ds)
/* Found it. Now, act like it was a selection.
*/
*ds = wds->w_desig;
wds->w_flags |= df->df_flags;
assert(ds->dsg_kind == DSG_PFIXED);
}
@ -583,10 +584,11 @@ CodeVarDesig(df, ds)
*/
C_lxa((arith) difflevel);
if ((df->df_flags & D_VARPAR) ||
IsBigParamTp(df->df_type) ||
IsConformantArray(df->df_type)) {
/* var parameter or conformant array.
For conformant array's, the address is
passed.
/* var parameter, big parameter,
or conformant array.
The address is passed.
*/
C_adp(df->var_off);
C_loi(pointer_size);
@ -603,7 +605,9 @@ CodeVarDesig(df, ds)
/* Now, finally, we have a local variable or a local parameter
*/
if ((df->df_flags & D_VARPAR) || IsConformantArray(df->df_type)) {
if ((df->df_flags & D_VARPAR) ||
((df->df_flags & D_VALPAR) && IsBigParamTp(df->df_type)) ||
IsConformantArray(df->df_type)) {
/* a var parameter; address directly accessible.
*/
ds->dsg_kind = DSG_PFIXED;

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

@ -222,7 +222,7 @@ EnterParamList(ppr, Idlist, type, VARp, off)
*/
*off += pointer_size + word_size + dword_size;
}
else if (VARp == D_VARPAR) {
else if (VARp == D_VARPAR || IsBigParamTp(type)) {
*off += pointer_size;
}
else {

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

@ -53,7 +53,7 @@ main(argc, argv)
register char **Nargv = &argv[0];
ProgName = *argv++;
DEFPATH = (char **) Malloc(mDEF * sizeof(char *));
DEFPATH = (char **) Malloc((unsigned)mDEF * sizeof(char *));
while (--argc > 0) {
if (**argv == '-')

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

@ -64,14 +64,16 @@ struct record {
struct proc {
struct paramlist *pr_params;
arith pr_nbpar;
arith pr_nbpar; /* number of bytes parameters accessed */
#define prc_params tp_value.tp_proc.pr_params
#define prc_nbpar tp_value.tp_proc.pr_nbpar
};
struct set {
arith st_low;
arith st_low; /* lowerbound of subrange type of set */
unsigned st_sz; /* size of constant set in compiler */
#define set_low tp_value.tp_set.st_low
#define set_sz tp_value.tp_set.st_sz
};
struct type {
@ -224,6 +226,7 @@ extern t_type
(tpx))
#define IsConstructed(tpx) ((tpx)->tp_fund & T_CONSTRUCTED)
#define TooBigForReturnArea(tpx) ((tpx)->tp_size > ret_area_size)
#define IsBigParamTp(tpx) ((tpx)->tp_size > double_size)
extern long full_mask[];
extern long max_int[];

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

@ -503,7 +503,7 @@ set_type(tp)
/* Construct a set type with base type "tp", but first
perform some checks
*/
arith lb, ub, diff;
arith lb, ub, diff, alloc_size;
if (! bounded(tp) || tp->tp_size > word_size) {
error("illegal base type for set");
@ -526,6 +526,12 @@ set_type(tp)
tp = construct_type(T_SET, tp);
tp->tp_size = WA((diff + 7) >> 3);
alloc_size = (tp->tp_size / word_size + 1) * sizeof(arith);
tp->set_sz = alloc_size;
if (tp->set_sz != alloc_size) {
error("set size too large");
return error_type;
}
tp->set_low = lb;
return tp;
}

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

@ -41,6 +41,7 @@
extern arith NewPtr();
extern arith NewInt();
extern arith TmpSpace();
extern int proclevel;
@ -61,7 +62,11 @@ static int UseWarnings();
#define NO_EXIT_LABEL ((label) 0)
#define RETURN_LABEL ((label) 1)
LblWalkNode(lbl, nd, exit)
#define REACH_FLAG 1
#define EXIT_FLAG 2
int
LblWalkNode(lbl, nd, exit, reach)
label lbl, exit;
register t_node *nd;
{
@ -71,7 +76,7 @@ LblWalkNode(lbl, nd, exit)
*/
def_ilb(lbl);
WalkNode(nd, exit);
return WalkNode(nd, exit, reach);
}
static arith tmpprio;
@ -104,6 +109,8 @@ EndPriority()
def_ilb(l)
label l;
{
/* Instruction label definition. Forget about line number.
*/
C_df_ilb(l);
oldlineno = 0;
}
@ -111,7 +118,11 @@ def_ilb(l)
DoLineno(nd)
register t_node *nd;
{
if (! options['L'] && nd->nd_lineno && nd->nd_lineno != oldlineno) {
/* Generate line number information, if necessary.
*/
if (! options['L'] &&
nd->nd_lineno &&
nd->nd_lineno != oldlineno) {
oldlineno = nd->nd_lineno;
C_lin((arith) nd->nd_lineno);
}
@ -119,6 +130,11 @@ DoLineno(nd)
DoFilename(needed)
{
/* Generate filename information, when needed.
This routine is called at the generation of a
procedure entry, and after generating a call to
another procedure.
*/
static label filename_label = 0;
oldlineno = 0; /* always invalidate remembered line number */
@ -182,6 +198,9 @@ WalkModule(module)
C_ine_dlb(data_label, (arith) 0);
}
else if (! options['R']) {
/* put funny value in BSS, in an attempt to detect
uninitialized variables
*/
C_cal("killbss");
}
@ -192,7 +211,7 @@ WalkModule(module)
}
WalkDefList(sc->sc_def, MkCalls);
proclevel++;
WalkNode(module->mod_body, NO_EXIT_LABEL);
WalkNode(module->mod_body, NO_EXIT_LABEL, REACH_FLAG);
DO_DEBUG(options['X'], PrNode(module->mod_body, 0));
def_ilb(RETURN_LABEL);
EndPriority();
@ -215,10 +234,13 @@ WalkProcedure(procedure)
register t_scope *procscope = procedure->prc_vis->sc_scope;
register t_type *tp;
register t_param *param;
int too_big = 0;
arith StackAdjustment = 0;
arith retsav = 0;
int too_big = 0; /* returnsize larger than returnarea */
arith StackAdjustment = 0; /* space for conformant arrays */
arith retsav = 0; /* temporary space for return value */
arith func_res_size = 0;
int partno = C_getid();
int partno2 = C_getid();
int end_reached; /* can fall through ... */
proclevel++;
CurrVis = procedure->prc_vis;
@ -242,17 +264,22 @@ WalkProcedure(procedure)
/* Generate code for this procedure
*/
C_pro_narg(procscope->sc_name);
C_ms_par(procedure->df_type->prc_nbpar +
(too_big ? func_res_size : 0));
TmpOpen(procscope);
C_insertpart(partno2);
C_insertpart(partno);
text_label = 1; /* label at end of procedure */
end_reached = WalkNode(procedure->prc_body, NO_EXIT_LABEL, REACH_FLAG);
C_beginpart(partno);
DoPriority();
/* generate code for filename only when the procedure can be
exported, either directly or by taking the address.
This cannot be done if the level is not zero (because in
This cannot be done if the level is bigger than one (because in
this case it is a nested procedure).
*/
DoFilename(! procscope->sc_level);
DoFilename(procscope->sc_level == 1);
/* Generate calls to initialization routines of modules defined within
this procedure
@ -261,7 +288,7 @@ WalkProcedure(procedure)
/* Make sure that arguments of size < word_size are on a
fixed place.
Also make copies of conformant arrays when neccessary.
Also make copies of parameters when neccessary.
*/
for (param = ParamList(procedure->df_type);
param;
@ -273,17 +300,37 @@ WalkProcedure(procedure)
if (tp->tp_size < word_size &&
(int) word_size % (int) tp->tp_size == 0) {
C_lol(param->par_def->var_off);
STL(param->par_def->var_off, tp->tp_size);
STL(param->par_def->var_off,
tp->tp_size);
continue;
}
if (IsBigParamTp(tp) &&
(param->par_def->df_flags & D_DEFINED)){
/* Value parameter changed in body.
Make a copy
*/
arith tmp = TmpSpace(tp->tp_size,
tp->tp_align);
LOL(param->par_def->var_off,
pointer_size);
C_lal(tmp);
CodeConst(WA(tp->tp_size),
(int)pointer_size);
C_bls(pointer_size);
C_lal(tmp);
STL(param->par_def->var_off,
pointer_size);
}
continue;
}
else {
if (param->par_def->df_flags & D_DEFINED) {
/* Here, we have to make a copy of the
array. We must also remember how much
room is reserved for copies, because
we have to adjust the stack pointer before
a RET is done. This is even more complicated
when the procedure returns a value.
Then, the value must be saved (in retval),
Then, the value must be saved,
the stack adjusted, the return value pushed
again, and then RET
*/
@ -295,9 +342,8 @@ WalkProcedure(procedure)
needed if the value itself
is returned
*/
procscope->sc_off -=
func_res_size;
retsav = procscope->sc_off;
retsav= TmpSpace(func_res_size,
1);
}
StackAdjustment = NewPtr();
C_lor((arith) 1);
@ -316,12 +362,13 @@ WalkProcedure(procedure)
}
}
}
text_label = 1; /* label at end of procedure */
WalkNode(procedure->prc_body, NO_EXIT_LABEL);
C_endpart(partno);
DO_DEBUG(options['X'], PrNode(procedure->prc_body, 0));
if (func_res_size) {
if ((end_reached & REACH_FLAG) && func_res_size) {
node_warning(procscope->sc_end,
W_ORDINARY,
"function procedure \"%s\" does not always return a value",
procedure->df_idf->id_text);
c_loc(M2_NORESULT);
C_trp();
C_asp(-func_res_size);
@ -357,10 +404,16 @@ WalkProcedure(procedure)
}
EndPriority();
C_ret(func_res_size);
C_beginpart(partno2);
C_pro(procscope->sc_name, -procscope->sc_off);
C_ms_par(procedure->df_type->prc_nbpar +
(too_big ? func_res_size : 0));
if (! options['n']) WalkDefList(procscope->sc_def, RegisterMessage);
C_endpart(partno2);
C_end(-procscope->sc_off);
if (! fit(procscope->sc_off, (int) word_size)) {
node_error(procedure->prc_body, "maximum local byte count exceeded");
node_error(procedure->prc_body,
"maximum local byte count exceeded");
}
TmpClose();
CurrVis = savevis;
@ -409,19 +462,22 @@ MkCalls(df)
}
}
WalkLink(nd, exit_label)
WalkLink(nd, exit_label, end_reached)
register t_node *nd;
label exit_label;
{
/* Walk node "nd", which is a link.
"exit_label" is set to a label number when inside a LOOP.
"end_reached" maintains info about reachability (REACH_FLAG),
and whether an EXIT statement was seen (EXIT_FLAG).
*/
while (nd && nd->nd_class == Link) { /* statement list */
WalkNode(nd->nd_left, exit_label);
end_reached = WalkNode(nd->nd_left, exit_label, end_reached);
nd = nd->nd_right;
}
WalkNode(nd, exit_label);
return WalkNode(nd, exit_label, end_reached);
}
STATIC
@ -434,7 +490,8 @@ ForLoopVarExpr(nd)
CodeCoercion(tp, BaseType(tp));
}
WalkStat(nd, exit_label)
int
WalkStat(nd, exit_label, end_reached)
register t_node *nd;
label exit_label;
{
@ -445,8 +502,11 @@ WalkStat(nd, exit_label)
assert(nd->nd_class == Stat);
if (nd->nd_symb == ';') return;
if (nd->nd_symb == ';') return 1;
if (! end_reached & REACH_FLAG) {
node_warning(nd, W_ORDINARY, "statement not reached");
}
DoLineno(nd);
options['R'] = (nd->nd_flags & ROPTION);
options['A'] = (nd->nd_flags & AOPTION);
@ -467,24 +527,26 @@ WalkStat(nd, exit_label)
case IF:
{ label l1 = ++text_label, l3 = ++text_label;
int end_r;
ExpectBool(left, l3, l1);
assert(right->nd_symb == THEN);
LblWalkNode(l3, right->nd_left, exit_label);
end_r = LblWalkNode(l3, right->nd_left, exit_label, end_reached);
if (right->nd_right) { /* ELSE part */
label l2 = ++text_label;
C_bra(l2);
LblWalkNode(l1, right->nd_right, exit_label);
end_reached = end_r | LblWalkNode(l1, right->nd_right, exit_label, end_reached);
l1 = l2;
}
else end_reached |= end_r;
def_ilb(l1);
break;
}
case CASE:
CaseCode(nd, exit_label);
end_reached = CaseCode(nd, exit_label, end_reached);
break;
case WHILE:
@ -492,10 +554,10 @@ WalkStat(nd, exit_label)
exit = ++text_label,
dummy = ++text_label;
def_ilb(loop);
ExpectBool(left, dummy, exit);
LblWalkNode(dummy, right, exit_label);
C_bra(loop);
C_bra(dummy);
end_reached |= LblWalkNode(loop, right, exit_label, end_reached);
def_ilb(dummy);
ExpectBool(left, loop, exit);
def_ilb(exit);
break;
}
@ -503,7 +565,7 @@ WalkStat(nd, exit_label)
case REPEAT:
{ label loop = ++text_label, exit = ++text_label;
LblWalkNode(loop, left, exit_label);
end_reached = LblWalkNode(loop, left, exit_label, end_reached);
ExpectBool(right, exit, loop);
def_ilb(exit);
break;
@ -512,7 +574,10 @@ WalkStat(nd, exit_label)
case LOOP:
{ label loop = ++text_label, exit = ++text_label;
LblWalkNode(loop, right, exit);
if (LblWalkNode(loop, right, exit, end_reached) & EXIT_FLAG) {
end_reached &= REACH_FLAG;
}
else end_reached = 0;
C_bra(loop);
def_ilb(exit);
break;
@ -575,7 +640,7 @@ WalkStat(nd, exit_label)
ForLoopVarExpr(nd);
C_stl(tmp2);
WalkNode(right, exit_label);
end_reached |= WalkNode(right, exit_label, end_reached);
C_lol(tmp2);
ForLoopVarExpr(nd);
C_beq(x);
@ -583,7 +648,7 @@ WalkStat(nd, exit_label)
C_trp();
def_ilb(x);
}
else WalkNode(right, exit_label);
else end_reached |= WalkNode(right, exit_label, end_reached);
nd->nd_def->df_flags &= ~D_FORLOOP;
FreeInt(tmp2);
if (stepsize) {
@ -601,7 +666,7 @@ WalkStat(nd, exit_label)
}
}
else {
WalkNode(right, exit_label);
end_reached |= WalkNode(right, exit_label, end_reached);
nd->nd_def->df_flags &= ~D_FORLOOP;
}
C_bra(l1);
@ -620,13 +685,14 @@ WalkStat(nd, exit_label)
struct withdesig wds;
t_desig ds;
if (! WalkDesignator(left, &ds, D_USED|D_DEFINED)) break;
if (! WalkDesignator(left, &ds, D_USED)) break;
if (left->nd_type->tp_fund != T_RECORD) {
node_error(left, "record variable expected");
break;
}
wds.w_next = WithDesigs;
wds.w_flags = D_USED;
WithDesigs = &wds;
wds.w_scope = left->nd_type->rec_scope;
CodeAddress(&ds);
@ -642,20 +708,23 @@ WalkStat(nd, exit_label)
link.sc_scope = wds.w_scope;
link.sc_next = CurrVis;
CurrVis = &link;
WalkNode(right, exit_label);
end_reached = WalkNode(right, exit_label, end_reached);
CurrVis = link.sc_next;
WithDesigs = wds.w_next;
FreePtr(ds.dsg_offset);
WalkDesignator(left, &ds, wds.w_flags & (D_USED|D_DEFINED));
break;
}
case EXIT:
assert(exit_label != 0);
if (end_reached & REACH_FLAG) end_reached = EXIT_FLAG;
C_bra(exit_label);
break;
case RETURN:
end_reached &= ~REACH_FLAG;
if (right) {
if (! ChkExpression(right)) break;
/* The type of the return-expression must be
@ -677,6 +746,7 @@ WalkStat(nd, exit_label)
default:
crash("(WalkStat)");
}
return end_reached;
}
extern int NodeCrash();
@ -900,16 +970,18 @@ UseWarnings(df)
}
switch(df->df_flags & (D_USED|D_DEFINED|D_VALPAR|D_VARPAR)) {
case 0:
case D_VALPAR:
case D_VARPAR:
warning = "never used/assigned";
break;
case D_USED|D_VARPAR:
warning = "never assigned, could be value parameter";
if (df->df_type->tp_fund != T_EQUAL) {
warning = "never assigned, could be value parameter";
}
break;
case D_USED:
warning = "never assigned";
break;
case D_VALPAR:
case D_DEFINED:
case D_DEFINED|D_VALPAR:
warning = "never used";
@ -924,7 +996,10 @@ warn:
"%s \"%s\" %s",
(df->df_flags & D_VALPAR) ? "value parameter" :
(df->df_flags & D_VARPAR) ? "variable parameter" :
"identifier",
(df->df_kind == D_VARIABLE) ? "variable" :
(df->df_kind == D_TYPE) ? "type" :
(df->df_kind == D_CONST) ? "constant" :
"procedure",
df->df_idf->id_text, warning);
}
}

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

@ -14,7 +14,7 @@
extern int (*WalkTable[])();
#define WalkNode(xnd, xlab) (*WalkTable[(xnd)->nd_class])((xnd), (xlab))
#define WalkNode(xnd, xlab, rch) (*WalkTable[(xnd)->nd_class])((xnd), (xlab),(rch))
extern label text_label;
extern label data_label;