if (nch == '=') {
return tk->tk_symb = LESSEQUAL;
}
+ if (nch == '>') {
+ lexwarning("'<>' is old-fashioned; use '#'");
+ return tk->tk_symb = '#';
+ }
PushBack(nch);
return tk->tk_symb = ch;
symbol2str.c: tokenname.c make.tokcase
make.tokcase <tokenname.c >symbol2str.c
-misc.h: misc.H make.allocd
def.h: def.H make.allocd
type.h: type.H make.allocd
node.h: node.H make.allocd
tokenname.o: Lpars.h idf.h tokenname.h
idf.o: idf.h
input.o: f_info.h input.h inputtype.h
-type.o: LLlex.h const.h debug.h def.h idf.h maxset.h node.h target_sizes.h type.h
+type.o: LLlex.h const.h debug.h def.h idf.h maxset.h node.h scope.h target_sizes.h type.h
def.o: LLlex.h Lpars.h debug.h def.h idf.h main.h node.h scope.h type.h
scope.o: LLlex.h debug.h def.h idf.h node.h scope.h type.h
misc.o: LLlex.h f_info.h idf.h misc.h node.h
enter.o: LLlex.h debug.h def.h idf.h main.h node.h scope.h type.h
defmodule.o: LLlex.h debug.h def.h f_info.h idf.h input.h inputtype.h main.h scope.h
-typequiv.o: def.h type.h
+typequiv.o: LLlex.h def.h node.h type.h
node.o: LLlex.h debug.h def.h node.h type.h
cstoper.o: LLlex.h Lpars.h debug.h idf.h node.h standards.h target_sizes.h type.h
chk_expr.o: LLlex.h Lpars.h const.h debug.h def.h idf.h node.h scope.h standards.h type.h
walk.o: LLlex.h Lpars.h debug.h def.h desig.h f_info.h idf.h main.h node.h scope.h type.h
casestat.o: LLlex.h Lpars.h debug.h density.h desig.h node.h type.h
desig.o: LLlex.h debug.h def.h desig.h node.h scope.h type.h
-code.o: LLlex.h Lpars.h debug.h def.h desig.h node.h scope.h type.h
+code.o: LLlex.h Lpars.h debug.h def.h desig.h node.h scope.h standards.h type.h
tmpvar.o: debug.h def.h scope.h type.h
tokenfile.o: Lpars.h
program.o: LLlex.h Lpars.h debug.h def.h idf.h main.h node.h scope.h type.h
struct node *
getarg(argp, bases, designator)
- struct node *argp;
+ struct node **argp;
{
struct type *tp;
+ register struct node *arg = *argp;
- if (!argp->nd_right) {
- node_error(argp, "too few arguments supplied");
+ if (!arg->nd_right) {
+ node_error(arg, "too few arguments supplied");
return 0;
}
- argp = argp->nd_right;
- if ((!designator && !chk_expr(argp->nd_left)) ||
- (designator && !chk_designator(argp->nd_left, DESIGNATOR, D_REFERRED))) {
+ arg = arg->nd_right;
+ if ((!designator && !chk_expr(arg->nd_left)) ||
+ (designator && !chk_designator(arg->nd_left, DESIGNATOR, D_REFERRED))) {
return 0;
}
- tp = argp->nd_left->nd_type;
+ tp = arg->nd_left->nd_type;
if (tp->tp_fund == T_SUBRANGE) tp = tp->next;
if (bases && !(tp->tp_fund & bases)) {
- node_error(argp, "unexpected type");
+ node_error(arg, "unexpected type");
return 0;
}
- return argp;
+
+ *argp = arg;
+ return arg->nd_left;
}
struct node *
getname(argp, kinds)
- struct node *argp;
+ struct node **argp;
{
- if (!argp->nd_right) {
- node_error(argp, "too few arguments supplied");
+ register struct node *arg = *argp;
+
+ if (!arg->nd_right) {
+ node_error(arg, "too few arguments supplied");
return 0;
}
- argp = argp->nd_right;
- if (! chk_designator(argp->nd_left, 0, D_REFERRED)) return 0;
+ arg = arg->nd_right;
+ if (! chk_designator(arg->nd_left, 0, D_REFERRED)) return 0;
- assert(argp->nd_left->nd_class == Def);
+ assert(arg->nd_left->nd_class == Def);
- if (!(argp->nd_left->nd_def->df_kind & kinds)) {
- node_error(argp, "unexpected type");
+ if (!(arg->nd_left->nd_def->df_kind & kinds)) {
+ node_error(arg, "unexpected type");
return 0;
}
- return argp;
+ *argp = arg;
+ return arg->nd_left;
}
int
left = expp->nd_left;
if (! chk_designator(left, 0, D_USED)) return 0;
- if (left->nd_class == Def && is_type(left->nd_def)) {
+ if (IsCast(left)) {
/* It was a type cast. This is of course not portable.
*/
- arg = expp->nd_right;
- if ((! arg) || arg->nd_right) {
-node_error(expp, "only one parameter expected in type cast");
- return 0;
- }
- arg = arg->nd_left;
- if (! chk_expr(arg)) return 0;
- if (arg->nd_type->tp_size != left->nd_type->tp_size) {
-node_error(expp, "unequal sizes in type cast");
- }
- if (arg->nd_class == Value) {
- struct type *tp = left->nd_type;
-
- FreeNode(expp->nd_left);
- expp->nd_right->nd_left = 0;
- FreeNode(expp->nd_right);
- expp->nd_left = expp->nd_right = 0;
- *expp = *arg;
- expp->nd_type = tp;
- }
- else expp->nd_type = left->nd_type;
-
- return 1;
+ return chk_cast(expp, left);
}
- if ((left->nd_class == Def && left->nd_def->df_kind == D_PROCEDURE) ||
- left->nd_type->tp_fund == T_PROCEDURE) {
+ if (IsProcCall(left)) {
/* A procedure call. it may also be a call to a
standard procedure
*/
- arg = expp;
if (left->nd_type == std_type) {
/* A standard procedure
*/
- return chk_std(expp, left, arg);
+ return chk_std(expp, left);
}
/* Here, we have found a real procedure call. The left hand
side may also represent a procedure variable.
}
chk_proccall(expp)
- struct node *expp;
+ register struct node *expp;
{
/* Check a procedure call
*/
register struct node *left;
- register struct node *arg;
+ struct node *arg;
register struct paramlist *param;
left = 0;
left = expp->nd_left;
arg = expp;
- arg->nd_type = left->nd_type->next;
+ expp->nd_type = left->nd_type->next;
param = left->nd_type->prc_params;
while (param) {
- if (!(arg = getarg(arg, 0, param->par_var))) return 0;
+ if (!(left = getarg(&arg, 0, IsVarParam(param)))) return 0;
- if (! TstParCompat(param->par_type,
- arg->nd_left->nd_type,
- param->par_var)) {
-node_error(arg->nd_left, "type incompatibility in parameter");
+ if (! TstParCompat(TypeOfParam(param),
+ left->nd_type,
+ IsVarParam(param),
+ left)) {
+node_error(left, "type incompatibility in parameter");
return 0;
}
- if (param->par_var && arg->nd_left->nd_class == Def) {
- arg->nd_left->nd_def->df_flags |= D_NOREG;
+ if (IsVarParam(param) && left->nd_class == Def) {
+ left->nd_def->df_flags |= D_NOREG;
}
param = param->next;
if (expp->nd_class == Link) {
assert(expp->nd_symb == '.');
- assert(expp->nd_right->nd_class == Name);
if (! chk_designator(expp->nd_left,
flag|HASSELECTORS,
assert(tp->tp_fund == T_RECORD);
- df = lookup(expp->nd_right->nd_IDF, tp->rec_scope);
+ df = lookup(expp->nd_IDF, tp->rec_scope);
if (!df) {
- id_not_declared(expp->nd_right);
+ id_not_declared(expp);
return 0;
}
else {
- expp->nd_right->nd_class = Def;
- expp->nd_right->nd_def = df;
+ expp->nd_def = df;
expp->nd_type = df->df_type;
if (!(df->df_flags & (D_EXPORTED|D_QEXPORTED))) {
-node_error(expp->nd_right,
-"identifier \"%s\" not exported from qualifying module",
+node_error(expp, "identifier \"%s\" not exported from qualifying module",
df->df_idf->id_text);
return 0;
}
expp->nd_class = Def;
expp->nd_def = df;
FreeNode(expp->nd_left);
- FreeNode(expp->nd_right);
- expp->nd_left = expp->nd_right = 0;
+ expp->nd_left = 0;
}
else {
- return FlagCheck(expp->nd_right, df, flag);
+ return FlagCheck(expp, df, flag);
}
}
}
struct node *
-getvariable(arg)
- register struct node *arg;
+getvariable(argp)
+ struct node **argp;
{
- struct def *df;
+ register struct node *arg = *argp;
+ register struct def *df;
register struct node *left;
arg = arg->nd_right;
if (! chk_designator(left, DESIGNATOR, D_REFERRED)) return 0;
if (left->nd_class == Oper || left->nd_class == Uoper) {
- return arg;
+ *argp = arg;
+ return left;
}
df = 0;
- if (left->nd_class == Link) df = left->nd_right->nd_def;
- else if (left->nd_class == Def) df = left->nd_def;
+ if (left->nd_class == Link || left->nd_class == Def) {
+ df = left->nd_def;
+ }
if (!df || !(df->df_kind & (D_VARIABLE|D_FIELD))) {
node_error(arg, "variable expected");
return 0;
}
- return arg;
+ *argp = arg;
+ return left;
}
int
-chk_std(expp, left, arg)
- register struct node *expp, *left, *arg;
+chk_std(expp, left)
+ register struct node *expp, *left;
{
/* Check a call of a standard procedure or function
*/
+ struct node *arg = expp;
+ int std;
assert(left->nd_class == Def);
-DO_DEBUG(3, debug("standard name \"%s\", %d",
-left->nd_def->df_idf->id_text, left->nd_def->df_value.df_stdname));
+ std = left->nd_def->df_value.df_stdname;
+
+DO_DEBUG(3,debug("standard name \"%s\", %d",left->nd_def->df_idf->id_text,std));
- switch(left->nd_def->df_value.df_stdname) {
+ switch(std) {
case S_ABS:
- if (!(arg = getarg(arg, T_NUMERIC, 0))) return 0;
- left = arg->nd_left;
+ if (!(left = getarg(&arg, T_NUMERIC, 0))) return 0;
expp->nd_type = left->nd_type;
if (left->nd_class == Value) cstcall(expp, S_ABS);
break;
case S_CAP:
expp->nd_type = char_type;
- if (!(arg = getarg(arg, T_CHAR, 0))) return 0;
- left = arg->nd_left;
+ if (!(left = getarg(&arg, T_CHAR, 0))) return 0;
if (left->nd_class == Value) cstcall(expp, S_CAP);
break;
case S_CHR:
expp->nd_type = char_type;
- if (!(arg = getarg(arg, T_INTORCARD, 0))) return 0;
- left = arg->nd_left;
+ if (!(left = getarg(&arg, T_INTORCARD, 0))) return 0;
if (left->nd_class == Value) cstcall(expp, S_CHR);
break;
case S_FLOAT:
expp->nd_type = real_type;
- if (!(arg = getarg(arg, T_INTORCARD, 0))) return 0;
+ if (!(left = getarg(&arg, T_INTORCARD, 0))) return 0;
break;
case S_HIGH:
- if (!(arg = getarg(arg, T_ARRAY, 0))) return 0;
- expp->nd_type = arg->nd_left->nd_type->next;
+ if (!(left = getarg(&arg, T_ARRAY, 0))) return 0;
+ expp->nd_type = left->nd_type->next;
if (!expp->nd_type) {
/* A dynamic array has no explicit index type
*/
case S_MAX:
case S_MIN:
- if (!(arg = getarg(arg, T_DISCRETE, 0))) return 0;
- expp->nd_type = arg->nd_left->nd_type;
- cstcall(expp,left->nd_def->df_value.df_stdname);
+ if (!(left = getarg(&arg, T_DISCRETE, 0))) return 0;
+ expp->nd_type = left->nd_type;
+ cstcall(expp,std);
break;
case S_ODD:
- if (!(arg = getarg(arg, T_INTORCARD, 0))) return 0;
+ if (!(left = getarg(&arg, T_INTORCARD, 0))) return 0;
expp->nd_type = bool_type;
- if (arg->nd_left->nd_class == Value) cstcall(expp, S_ODD);
+ if (left->nd_class == Value) cstcall(expp, S_ODD);
break;
case S_ORD:
- if (!(arg = getarg(arg, T_DISCRETE, 0))) return 0;
+ if (!(left = getarg(&arg, T_DISCRETE, 0))) return 0;
+ if (left->nd_type->tp_size > word_size) {
+ node_error(left, "illegal type in argument of ORD");
+ return 0;
+ }
expp->nd_type = card_type;
- if (arg->nd_left->nd_class == Value) cstcall(expp, S_ORD);
+ if (left->nd_class == Value) cstcall(expp, S_ORD);
break;
case S_TSIZE: /* ??? */
case S_SIZE:
expp->nd_type = intorcard_type;
- arg = getname(arg, D_FIELD|D_VARIABLE|D_ISTYPE);
- if (!arg) return 0;
+ if (! getname(&arg, D_FIELD|D_VARIABLE|D_ISTYPE)) return 0;
cstcall(expp, S_SIZE);
break;
case S_TRUNC:
expp->nd_type = card_type;
- if (!(arg = getarg(arg, T_REAL, 0))) return 0;
+ if (!(left = getarg(&arg, T_REAL, 0))) return 0;
break;
case S_VAL:
{
struct type *tp;
- if (!(arg = getname(arg, D_ISTYPE))) return 0;
- tp = arg->nd_left->nd_def->df_type;
+ if (!(left = getname(&arg, D_ISTYPE))) return 0;
+ tp = left->nd_def->df_type;
if (tp->tp_fund == T_SUBRANGE) tp = tp->next;
if (!(tp->tp_fund & T_DISCRETE)) {
node_error(arg, "unexpected type");
return 0;
}
- expp->nd_type = arg->nd_left->nd_def->df_type;
+ expp->nd_type = left->nd_def->df_type;
expp->nd_right = arg->nd_right;
arg->nd_right = 0;
FreeNode(arg);
- arg = getarg(expp, T_INTORCARD, 0);
- if (!arg) return 0;
- if (arg->nd_left->nd_class == Value) cstcall(expp, S_VAL);
+ arg = expp;
+ if (!(left = getarg(&arg, T_INTORCARD, 0))) return 0;
+ if (left->nd_class == Value) cstcall(expp, S_VAL);
break;
}
case S_ADR:
expp->nd_type = address_type;
- if (!(arg = getarg(arg, 0, 1))) return 0;
+ if (!(left = getarg(&arg, 0, 1))) return 0;
break;
case S_DEC:
case S_INC:
expp->nd_type = 0;
- if (!(arg = getvariable(arg))) return 0;
+ if (! (left = getvariable(&arg))) return 0;
+ if (! (left->nd_type->tp_fund & T_DISCRETE)) {
+node_error(left, "illegal type in argument of INC or DEC");
+ return 0;
+ }
if (arg->nd_right) {
- if (!(arg = getarg(arg, T_INTORCARD, 0))) return 0;
+ if (! getarg(&arg, T_INTORCARD, 0)) return 0;
}
break;
struct type *tp;
expp->nd_type = 0;
- if (!(arg = getvariable(arg))) return 0;
- tp = arg->nd_left->nd_type;
+ if (!(left = getvariable(&arg))) return 0;
+ tp = left->nd_type;
if (tp->tp_fund != T_SET) {
node_error(arg, "EXCL and INCL expect a SET parameter");
return 0;
}
- if (!(arg = getarg(arg, T_DISCRETE, 0))) return 0;
- if (!TstAssCompat(tp->next, arg->nd_left->nd_type)) {
+ if (!(left = getarg(&arg, T_DISCRETE, 0))) return 0;
+ if (!TstAssCompat(tp->next, left->nd_type)) {
/* What type of compatibility do we want here?
apparently assignment compatibility! ??? ???
*/
}
default:
- assert(0);
+ crash("(chk_std)");
}
if (arg->nd_right) {
return 1;
}
+
+chk_cast(expp, left)
+ register struct node *expp, *left;
+{
+ /* 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
+ has a size larger than the word size.
+ If both sizes are equal to or smaller than the word size, there
+ is no problem as such values take a word on the EM stack
+ anyway.
+ */
+ register struct node *arg = expp->nd_right;
+
+ if ((! arg) || arg->nd_right) {
+node_error(expp, "only one parameter expected in type cast");
+ return 0;
+ }
+
+ arg = arg->nd_left;
+ if (! chk_expr(arg)) return 0;
+
+ if (arg->nd_type->tp_size != left->nd_type->tp_size &&
+ (arg->nd_type->tp_size > word_size ||
+ left->nd_type->tp_size > word_size)) {
+ node_error(expp, "unequal sizes in type cast");
+ }
+
+ if (arg->nd_class == Value) {
+ struct type *tp = left->nd_type;
+
+ FreeNode(left);
+ expp->nd_right->nd_left = 0;
+ FreeNode(expp->nd_right);
+ expp->nd_left = expp->nd_right = 0;
+ *expp = *arg;
+ expp->nd_type = tp;
+ }
+ else expp->nd_type = left->nd_type;
+
+ return 1;
+}
#include "LLlex.h"
#include "node.h"
#include "Lpars.h"
+#include "standards.h"
extern label data_label();
extern label text_label();
switch(nd->nd_class) {
case Def:
+ if (nd->nd_def->df_kind == D_PROCEDURE) {
+ C_lpi(nd->nd_def->prc_vis->sc_scope->sc_name);
+ ds->dsg_kind = DSG_LOADED;
+ break;
+ }
CodeDesig(nd, ds);
break;
CodeDesig(nd, ds);
break;
}
- CodeExpr(nd->nd_right, ds, NO_LABEL, NO_LABEL);
- CodeValue(ds, nd->nd_right->nd_type->tp_size);
+ CodePExpr(nd->nd_right);
CodeUoper(nd);
ds->dsg_kind = DSG_LOADED;
break;
if ((fund2 = t2->tp_fund) == T_WORD) fund2 = T_INTEGER;
switch(fund1) {
case T_INTEGER:
+ case T_INTORCARD:
switch(fund2) {
case T_INTEGER:
if (t2->tp_size != t1->tp_size) {
register struct paramlist *param;
struct type *tp;
arith pushed = 0;
- struct desig Des;
if (left->nd_type == std_type) {
CodeStd(nd);
}
tp = left->nd_type;
- if (left->nd_class == Def && is_type(left->nd_def)) {
+ if (IsCast(left)) {
/* it was just a cast. Simply ignore it
*/
- Des = InitDesig;
- CodeExpr(nd->nd_right->nd_left, &Des, NO_LABEL, NO_LABEL);
- CodeValue(&Des, tp->tp_size);
+ CodePExpr(nd->nd_right->nd_left);
*nd = *(nd->nd_right->nd_left);
nd->nd_type = left->nd_def->df_type;
return;
}
- assert(tp->tp_fund == T_PROCEDURE);
+ assert(IsProcCall(left));
for (param = left->nd_type->prc_params; param; param = param->next) {
- Des = InitDesig;
arg = arg->nd_right;
assert(arg != 0);
- if (param->par_var) {
- CodeDesig(arg->nd_left, &Des);
- CodeAddress(&Des);
+ if (IsVarParam(param)) {
+ CodeDAddress(arg->nd_left);
pushed += pointer_size;
}
else {
- CodeExpr(arg->nd_left, &Des, NO_LABEL, NO_LABEL);
- CodeValue(&Des, arg->nd_left->nd_type->tp_size);
- CheckAssign(arg->nd_left->nd_type, param->par_type);
+ CodePExpr(arg->nd_left);
+ CheckAssign(arg->nd_left->nd_type, TypeOfParam(param));
pushed += align(arg->nd_left->nd_type->tp_size, word_align);
}
/* ??? Conformant arrays */
C_cal(left->nd_def->for_name);
}
else {
- Des = InitDesig;
- CodeDesig(left, &Des);
- CodeAddress(&Des);
+ CodePExpr(left);
C_cai();
}
C_asp(pushed);
CodeStd(nd)
struct node *nd;
{
- /* ??? */
+ register struct node *arg = nd->nd_right;
+ register struct node *left = 0;
+ register struct type *tp = 0;
+ int std;
+
+ if (arg) {
+ left = arg->nd_left;
+ tp = left->nd_type;
+ if (tp->tp_fund == T_SUBRANGE) tp = tp->next;
+ arg = arg->nd_right;
+ }
+ Desig = InitDesig;
+
+ switch(std = nd->nd_left->nd_def->df_value.df_stdname) {
+ case S_ABS:
+ CodePExpr(left);
+ if (tp->tp_fund == T_INTEGER) {
+ if (tp->tp_size == int_size) {
+ C_cal("_absi");
+ }
+ else C_cal("_absl");
+ }
+ else if (tp->tp_fund == T_REAL) {
+ if (tp->tp_size == float_size) {
+ C_cal("_absf");
+ }
+ else C_cal("_absd");
+ }
+ C_lfr(tp->tp_size);
+ break;
+
+ case S_CAP:
+ CodePExpr(left);
+ C_loc((arith) 0137);
+ C_and(word_size);
+ break;
+
+ case S_CHR:
+ CodePExpr(left);
+ CheckAssign(char_type, tp);
+ break;
+
+ case S_FLOAT:
+ CodePExpr(left);
+ CodeCoercion(tp, real_type);
+ break;
+
+ case S_HIGH:
+ assert(IsConformantArray(tp));
+ /* ??? */
+ break;
+
+ case S_ODD:
+ if (tp->tp_size == word_size) {
+ C_loc((arith) 1);
+ C_and(word_size);
+ }
+ else {
+ assert(tp->tp_size == dword_size);
+ C_ldc((arith) 1);
+ C_and(dword_size);
+ C_ior(word_size);
+ }
+ break;
+
+ case S_ORD:
+ CodePExpr(left);
+ break;
+
+ case S_TRUNC:
+ CodePExpr(left);
+ CodeCoercion(tp, card_type);
+ break;
+
+ case S_VAL:
+ CodePExpr(left);
+ CheckAssign(nd->nd_type, tp);
+ break;
+
+ case S_ADR:
+ CodeDAddress(left);
+ break;
+
+ case S_DEC:
+ case S_INC:
+ CodePExpr(left);
+ if (arg) CodePExpr(arg->nd_left);
+ else C_loc((arith) 1);
+ if (tp->tp_size <= word_size) {
+ if (std == S_DEC) {
+ if (tp->tp_fund == T_INTEGER) C_sbi(word_size);
+ else C_sbu(word_size);
+ }
+ else {
+ if (tp->tp_fund == T_INTEGER) C_adi(word_size);
+ else C_adu(word_size);
+ }
+ CheckAssign(tp, int_type);
+ }
+ else {
+ CodeCoercion(int_type, tp);
+ if (std == S_DEC) {
+ if (tp->tp_fund==T_INTEGER) C_sbi(tp->tp_size);
+ else C_sbu(tp->tp_size);
+ }
+ else {
+ if (tp->tp_fund==T_INTEGER) C_adi(tp->tp_size);
+ else C_adu(tp->tp_size);
+ }
+ }
+ CodeDStore(left);
+ break;
+
+ case S_HALT:
+ C_cal("_halt");
+ break;
+
+ case S_INCL:
+ case S_EXCL:
+ CodePExpr(left);
+ CodePExpr(arg->nd_left);
+ C_set(tp->tp_size);
+ if (std == S_INCL) {
+ C_ior(tp->tp_size);
+ }
+ else {
+ C_com(tp->tp_size);
+ C_and(tp->tp_size);
+ }
+ CodeDStore(left);
+ break;
+
+ default:
+ crash("(CodeStd)");
+ }
}
CodeAssign(nd, dss, dst)
CodeStore(dst, nd->nd_left->nd_type->tp_size);
}
else {
+ CodeAddress(dss);
CodeAddress(dst);
C_blm(nd->nd_left->nd_type->tp_size);
}
Operands(leftop, rightop)
register struct node *leftop, *rightop;
{
- struct desig Des;
- Des = InitDesig;
- CodeExpr(leftop, &Des, NO_LABEL, NO_LABEL);
- CodeValue(&Des, leftop->nd_type->tp_size);
- Des = InitDesig;
+ CodePExpr(leftop);
if (rightop->nd_type->tp_fund == T_POINTER &&
leftop->nd_type->tp_size != pointer_size) {
leftop->nd_type = rightop->nd_type;
}
- CodeExpr(rightop, &Des, NO_LABEL, NO_LABEL);
- CodeValue(&Des, rightop->nd_type->tp_size);
+ CodePExpr(rightop);
}
CodeOper(expr, true_label, false_label)
C_asp(2 * word_size + pointer_size);
}
else {
- struct desig Des;
-
- Des = InitDesig;
- CodeExpr(nd, &Des, NO_LABEL, NO_LABEL);
- CodeValue(&Des, word_size);
+ CodePExpr(nd);
C_set(tp->tp_size);
}
}
+
+CodePExpr(nd)
+ struct node *nd;
+{
+ /* Generate code to push the value of the expression "nd"
+ on the stack.
+ */
+ struct desig designator;
+
+ designator = InitDesig;
+ CodeExpr(nd, &designator, NO_LABEL, NO_LABEL);
+ CodeValue(&designator, nd->nd_type->tp_size);
+}
+
+CodeDAddress(nd)
+ struct node *nd;
+{
+ /* Generate code to push the address of the designator "nd"
+ on the stack.
+ */
+
+ struct desig designator;
+
+ designator = InitDesig;
+ CodeDesig(nd, &designator);
+ CodeAddress(&designator);
+}
+
+CodeDStore(nd)
+ register struct node *nd;
+{
+ /* Generate code to store the expression on the stack into the
+ designator "nd".
+ */
+
+ struct desig designator;
+
+ designator = InitDesig;
+ CodeDesig(nd, &designator);
+ CodeStore(&designator, nd->nd_type->tp_size);
+}
int proclevel = 0; /* nesting level of procedures */
extern char *sprint();
-extern struct def *currentdef;
}
ProcedureDeclaration
{
struct def *df;
- struct def *savecurr = currentdef;
} :
+ { proclevel++; }
ProcedureHeading(&df, D_PROCEDURE)
{
- currentdef = df;
+ CurrentScope->sc_definedby = df;
+ df->prc_vis = CurrVis;
}
';' block(&(df->prc_body)) IDENT
{
match_id(dot.TOK_IDF, df->df_idf);
- df->prc_vis = CurrVis;
close_scope(SC_CHKFORW|SC_REVERSE);
proclevel--;
- currentdef = savecurr;
}
;
} :
PROCEDURE IDENT
{
- if (type == D_PROCEDURE) proclevel++;
df = DeclProc(type);
tp = construct_type(T_PROCEDURE, tp);
- if (proclevel > 1) {
+ if (proclevel) {
/* Room for static link
*/
tp->prc_nbpar = pointer_size;
}
else tp->prc_nbpar = 0;
}
- FormalParameters(type == D_PROCEDURE, ¶ms, &(tp->next), &(tp->prc_nbpar))?
+ FormalParameters(¶ms, &(tp->next), &(tp->prc_nbpar))?
{
tp->prc_params = params;
if (df->df_type) {
df->df_type = tp;
*pdf = df;
+ if (type == D_PROCHEAD) close_scope(0);
+
DO_DEBUG(1, type == D_PROCEDURE &&
(print("proc %s:", df->df_idf->id_text),
DumpType(tp), print("\n")));
ModuleDeclaration ';'
;
-FormalParameters(int doparams;
- struct paramlist **pr;
+FormalParameters(struct paramlist **pr;
struct type **tp;
arith *parmaddr;)
{
struct def *df;
- register struct paramlist *pr1;
} :
'('
[
- FPSection(doparams, pr, parmaddr)
+ FPSection(pr, parmaddr)
[
- { for (pr1 = *pr; pr1->next; pr1 = pr1->next) ; }
- ';' FPSection(doparams, &(pr1->next), parmaddr)
+ ';' FPSection(pr, parmaddr)
]*
]?
')'
]?
;
-/* In the next nonterminal, "doparams" is a flag indicating whether
- the identifiers representing the parameters must be added to the
- symbol table. We must not do so when reading a Definition Module,
- because in this case we only read the header. The Implementation
- might contain different identifiers representing the same paramters.
-*/
-FPSection(int doparams; struct paramlist **ppr; arith *addr;)
+FPSection(struct paramlist **ppr; arith *parmaddr;)
{
struct node *FPList;
- struct paramlist *ParamList();
struct type *tp;
int VARp = 0;
} :
]?
IdentList(&FPList) ':' FormalType(&tp)
{
- if (doparams) {
- EnterIdList(FPList, D_VARIABLE, VARp,
- tp, CurrentScope, addr);
- }
- *ppr = ParamList(FPList, tp, VARp);
+ ParamList(ppr, FPList, tp, VARp, parmaddr);
FreeNode(FPList);
}
;
} :
'(' { *ppr = 0; }
[
- [ VAR { VARp = 1; }
- | { VARp = 0; }
+ [ VAR { VARp = D_VARPAR; }
+ | { VARp = D_VALPAR; }
]
FormalType(&tp)
{ *ppr = p = new_paramlist();
- p->par_type = tp;
- p->par_var = VARp;
+ p->next = 0;
+ p->par_def = df = new_def();
+ df->df_type = tp;
+ df->df_flags = VARp;
}
[
','
- [ VAR {VARp = 1; }
- | {VARp = 0; }
+ [ VAR {VARp = D_VARPAR; }
+ | {VARp = D_VALPAR; }
]
FormalType(&tp)
- { p->next = new_paramlist();
- p = p->next;
- p->par_type = tp;
- p->par_var = VARp;
+ { p = new_paramlist();
+ p->next = *ppr; *ppr = p;
+ p->par_def = df = new_def();
+ df->df_type = tp;
+ df->df_flags = VARp;
}
]*
- { p->next = 0; }
]?
')'
[ ':' qualident(D_TYPE, &df, "type", (struct node **) 0)
#include "node.h"
#include "Lpars.h"
-struct def *h_def; /* Pointer to free list of def structures */
+struct def *h_def; /* pointer to free list of def structures */
+#ifdef DEBUG
+int cnt_def; /* count number of allocated ones */
+#endif
struct def *ill_df;
df->for_name = Malloc((unsigned) (strlen(buf)+1));
strcpy(df->for_name, buf);
C_exp(df->for_name);
+ open_scope(OPENSCOPE);
}
else {
df = lookup(dot.TOK_IDF, CurrentScope);
case Link:
assert(nd->nd_symb == '.');
- assert(nd->nd_right->nd_class == Def);
CodeDesig(nd->nd_left, ds);
- CodeFieldDesig(nd->nd_right->nd_def, ds);
+ CodeFieldDesig(nd->nd_def, ds);
break;
case Oper:
}
if (*addr >= 0) {
- if (scope->sc_level && kind != D_FIELD) {
- /* alignment of parameters is on
- word boundaries. We cannot do any
- better, because we don't know the
- alignment of the stack pointer when
- starting to push parameters
- */
- xalign = word_align;
- }
off = align(*addr, xalign);
*addr = off + type->tp_size;
}
selector(struct node **pnd;):
'.' { *pnd = MkNode(Link,*pnd,NULLNODE,&dot); }
- IDENT { (*pnd)->nd_right = MkNode(Name,NULLNODE,NULLNODE,&dot); }
+ IDENT { (*pnd)->nd_IDF = dot.TOK_IDF; }
;
ExpList(struct node **pnd;)
}
WalkModule(Defined);
C_close();
+#ifdef DEBUG
+ if (options['m']) MemUse();
+#endif
if (err_occurred) return 0;
return 1;
}
*/
return 1;
}
+
+#ifdef DEBUG
+MemUse()
+{
+ extern int cnt_def, cnt_node, cnt_paramlist, cnt_type,
+ cnt_switch_hdr, cnt_case_entry,
+ cnt_scope, cnt_scopelist, cnt_forwards, cnt_tmpvar;
+
+ print("\
+%6d def\n%6d node\n%6d paramlist\n%6d type\n%6d switch_hdr\n\
+%6d case_entry\n%6d scope\n%6d scopelist\n%6d forwards\n%6d tmpvar\n",
+cnt_def, cnt_node, cnt_paramlist, cnt_type,
+cnt_switch_hdr, cnt_case_entry,
+cnt_scope, cnt_scopelist, cnt_forwards, cnt_tmpvar);
+}
+#endif
/* allocation definitions of struct \1 */\
extern char *st_alloc();\
extern struct \1 *h_\1;\
-#define new_\1() ((struct \1 *) \\\
- st_alloc((char **)\&h_\1, sizeof(struct \1)))\
+#ifdef DEBUG\
+extern int cnt_\1;\
+#define new_\1() ((struct \1 *) std_alloc((char **)\&h_\1, sizeof(struct \1), \&cnt_\1))\
+#else\
+#define new_\1() ((struct \1 *) st_alloc((char **)\&h_\1, sizeof(struct \1)))\
+#endif\
#define free_\1(p) st_free(p, h_\1, sizeof(struct \1))\
:' -e '
s:^.*[ ]STATICALLOCDEF[ ].*"\(.*\)".*$:\
/* allocation definitions of struct \1 */\
extern char *st_alloc();\
-static struct \1 *h_\1;\
-#define new_\1() ((struct \1 *) \\\
- st_alloc((char **)\&h_\1, sizeof(struct \1)))\
+struct \1 *h_\1;\
+#ifdef DEBUG\
+int cnt_\1;\
+#define new_\1() ((struct \1 *) std_alloc((char **)\&h_\1, sizeof(struct \1), \&cnt_\1))\
+#else\
+#define new_\1() ((struct \1 *) st_alloc((char **)\&h_\1, sizeof(struct \1)))\
+#endif\
#define free_\1(p) st_free(p, h_\1, sizeof(struct \1))\
:'
--- /dev/null
+/* M I S C E L L A N E O U S */
+
+/* $Header$ */
+
+#define is_anon_idf(x) ((x)->id_text[0] == '#')
+
+extern struct idf
+ *gen_anon_idf();
#define HASSELECTORS 2
#define VARIABLE 4
#define VALUE 8
+
+#define IsCast(lnd) ((lnd)->nd_class == Def && is_type((lnd)->nd_def))
+#define IsProcCall(lnd) ((lnd)->nd_type->tp_fund == T_PROCEDURE)
#include "node.h"
struct node *h_node; /* header of free list */
+#ifdef DEBUG
+int cnt_node; /* count number of allocated ones */
+#endif
struct node *
MkNode(class, left, right, token)
options[text[-1]] = 1; /* flags, debug options etc. */
break;
- case 'L' :
- warning("-L: default no EM profiling; use -p for EM profiling");
+ case 'L' : /* don't generate fil/lin */
+ options['L'] = 1;
break;
case 'M': /* maximum identifier length */
fatal("maximum identifier length is %d", IDFSIZE);
break;
- case 'p' : /* generate profiling code (fil/lin) */
+ case 'p' : /* generate profiling code procentry/procexit ???? */
options['p'] = 1;
break;
implementation module currently being
compiled
*/
-struct def *currentdef; /* current definition of module or procedure */
}
/*
The grammar as given by Wirth is already almost LL(1); the
{
struct idf *id;
register struct def *df;
- struct def *savecurr = currentdef;
extern int proclevel;
static int modulecount = 0;
char buf[256];
MODULE IDENT {
id = dot.TOK_IDF;
df = define(id, CurrentScope, D_MODULE);
- currentdef = df;
if (!df->mod_vis) {
open_scope(CLOSEDSCOPE);
CurrVis = df->mod_vis;
CurrentScope->sc_level = proclevel;
}
+ CurrentScope->sc_definedby = df;
df->df_type = standard_type(T_RECORD, 0, (arith) 0);
df->df_type->rec_scope = df->mod_vis->sc_scope;
}
close_scope(SC_CHKFORW|SC_CHKPROC|SC_REVERSE);
match_id(id, dot.TOK_IDF);
- currentdef = savecurr;
}
;
if (state == IMPLEMENTATION) {
DEFofIMPL = 1;
df = GetDefinitionModule(id);
- currentdef = df;
CurrVis = df->mod_vis;
CurrentScope = CurrVis->sc_scope;
DEFofIMPL = 0;
df->mod_vis = CurrVis;
CurrentScope->sc_name = id->id_text;
}
+ CurrentScope->sc_definedby = df;
}
priority(&(df->mod_priority))?
';' import(0)*
*/
register struct scope *sc = new_scope();
register struct scopelist *ls = new_scopelist();
-
+
assert(scopetype == OPENSCOPE || scopetype == CLOSEDSCOPE);
+
+ clear((char *) sc, sizeof (*sc));
sc->sc_scopeclosed = scopetype == CLOSEDSCOPE;
sc->sc_level = proclevel;
- sc->sc_forw = 0;
- sc->sc_def = 0;
- sc->sc_off = 0;
if (scopetype == OPENSCOPE) {
ls->next = CurrVis;
}
arith sc_off; /* offsets of variables in this scope */
char sc_scopeclosed; /* flag indicating closed or open scope */
int sc_level; /* level of this scope */
+ struct def *sc_definedby; /* The def structure defining this scope */
};
struct scopelist {
#include "node.h"
static int loopcount = 0; /* Count nested loops */
-extern struct def *currentdef;
}
statement(struct node **pnd;)
WithStatement(pnd)
|
EXIT
- { if (!loopcount) {
-error("EXIT not in a LOOP");
- }
+ { if (!loopcount) error("EXIT not in a LOOP");
*pnd = MkNode(Stat, NULLNODE, NULLNODE, &dot);
}
|
- RETURN { *pnd = nd = MkNode(Stat, NULLNODE, NULLNODE, &dot); }
- [
- expression(&(nd->nd_right))
- { if (scopeclosed(CurrentScope)) {
-error("a module body has no result value");
- }
- else if (! currentdef->df_type->next) {
-error("procedure \"%s\" has no result value", currentdef->df_idf->id_text);
- }
- }
- |
- { if (currentdef->df_type->next) {
-error("procedure \"%s\" must return a value", currentdef->df_idf->id_text);
- }
- }
- ]
+ ReturnStatement(pnd)
]?
;
ForStatement(struct node **pnd;)
{
register struct node *nd;
+ struct node *dummy;
}:
FOR { *pnd = MkNode(Stat, NULLNODE, NULLNODE, &dot); }
- IDENT { nd = MkNode(Name, NULLNODE, NULLNODE, &dot); }
- BECOMES { nd = MkNode(BECOMES, nd, NULLNODE, &dot); }
- expression(&(nd->nd_right))
- TO { (*pnd)->nd_left=nd=MkNode(Link,nd,NULLNODE,&dot); }
+ IDENT { (*pnd)->nd_IDF = dot.TOK_IDF; }
+ BECOMES { nd = MkNode(Stat, NULLNODE, NULLNODE, &dot);
+ (*pnd)->nd_left = nd;
+ }
+ expression(&(nd->nd_left))
+ TO
expression(&(nd->nd_right))
[
- BY { nd->nd_right=MkNode(Link,NULLNODE,nd->nd_right,&dot);
+ BY
+ ConstExpression(&dummy)
+ {
+ if (!(dummy->nd_type->tp_fund & T_INTORCARD)) {
+ error("illegal type in BY clause");
+ }
+ nd->nd_INT = dummy->nd_INT;
+ FreeNode(dummy);
}
- ConstExpression(&(nd->nd_right->nd_left))
|
+ { nd->nd_INT = 1; }
]
DO
StatementSequence(&((*pnd)->nd_right))
StatementSequence(&(nd->nd_right))
END
;
+
+ReturnStatement(struct node **pnd;)
+{
+ register struct def *df = CurrentScope->sc_definedby;
+ register struct node *nd;
+} :
+
+ RETURN { *pnd = nd = MkNode(Stat, NULLNODE, NULLNODE, &dot); }
+ [
+ expression(&(nd->nd_right))
+ { if (scopeclosed(CurrentScope)) {
+error("a module body has no result value");
+ }
+ else if (! df->df_type->next) {
+error("procedure \"%s\" has no result value", df->df_idf->id_text);
+ }
+ }
+ |
+ { if (df->df_type->next) {
+error("procedure \"%s\" must return a value", df->df_idf->id_text);
+ }
+ }
+ ]
+;
struct paramlist { /* structure for parameterlist of a PROCEDURE */
struct paramlist *next;
- struct type *par_type; /* Parameter type */
- int par_var; /* flag, set if VAR parameter */
+ struct def *par_def; /* "df" of parameter */
+#define IsVarParam(xpar) ((xpar)->par_def->df_flags & D_VARPAR)
+#define TypeOfParam(xpar) ((xpar)->par_def->df_type)
};
/* ALLOCDEF "paramlist" */
#include "LLlex.h"
#include "node.h"
#include "const.h"
+#include "scope.h"
/* To be created dynamically in main() from defaults or from command
line parameters.
*error_type;
struct paramlist *h_paramlist;
+#ifdef DEBUG
+int cnt_paramlist;
+#endif
struct type *h_type;
+#ifdef DEBUG
+int cnt_type;
+#endif
extern label data_label();
error_type = standard_type(T_CHAR, 1, (arith) 1);
}
-/* Create a parameterlist of a procedure and return a pointer to it.
- "ids" indicates the list of identifiers, "tp" their type, and
- "VARp" is set when the parameters are VAR-parameters.
- Actually, "ids" is only used because it tells us how many parameters
- there were with this type.
-*/
-struct paramlist *
-ParamList(ids, tp, VARp)
+ParamList(ppr, ids, tp, VARp, off)
register struct node *ids;
+ struct paramlist **ppr;
struct type *tp;
+ arith *off;
{
+ /* Create (part of) a parameterlist of a procedure.
+ "ids" indicates the list of identifiers, "tp" their type, and
+ "VARp" is set when the parameters are VAR-parameters.
+*/
register struct paramlist *pr;
+ register struct def *df;
struct paramlist *pstart;
- pstart = pr = new_paramlist();
- pr->par_type = tp;
- pr->par_var = VARp;
- for (ids = ids->next; ids; ids = ids->next) {
- pr->next = new_paramlist();
- pr = pr->next;
- pr->par_type = tp;
- pr->par_var = VARp;
+ while (ids) {
+ pr = new_paramlist();
+ pr->next = *ppr;
+ *ppr = pr;
+ df = define(ids->nd_IDF, CurrentScope, D_VARIABLE);
+ pr->par_def = df;
+ df->df_type = tp;
+ if (VARp) df->df_flags = D_VARPAR;
+ else df->df_flags = D_VALPAR;
+ df->var_off = align(*off, word_align);
+ *off = df->var_off + tp->tp_size;
+ ids = ids->next;
}
- pr->next = 0;
- return pstart;
}
chk_basesubrange(tp, base)
if (par) {
print("; p:");
while(par) {
- if (par->par_var) print("VAR ");
- DumpType(par->par_type);
+ if (IsVarParam(par)) print("VAR ");
+ DumpType(TypeOfParam(par));
par = par->next;
}
}
#include "type.h"
#include "def.h"
+#include "LLlex.h"
+#include "node.h"
int
TstTypeEquiv(tp1, tp2)
/* Now check the parameters
*/
while (p1 && p2) {
- if (p1->par_var != p2->par_var ||
- !TstParEquiv(p1->par_type, p2->par_type)) return 0;
+ if (IsVarParam(p1) != IsVarParam(p2) ||
+ !TstParEquiv(TypeOfParam(p1), TypeOfParam(p2))) return 0;
p1 = p1->next;
p2 = p2->next;
}
}
int
-TstParCompat(formaltype, actualtype, VARflag)
+TstParCompat(formaltype, actualtype, VARflag, nd)
struct type *formaltype, *actualtype;
+ struct node *nd;
{
- /* Check type compatibility for a parameter in a procedure
- call. Ordinary type compatibility is sufficient in any case.
+ /* Check type compatibility for a parameter in a procedure call.
Assignment compatibility may do if the parameter is
a value parameter.
Otherwise, a conformant array may do, or an ARRAY OF WORD
*/
return
- TstCompat(formaltype, actualtype)
+ TstTypeEquiv(formaltype, actualtype)
||
( !VARflag && TstAssCompat(formaltype, actualtype))
||
- ( formaltype == word_type && actualtype->tp_size == word_size)
+ ( formaltype == word_type
+ &&
+ ( actualtype->tp_size == word_size
+ ||
+ ( !VARflag
+ &&
+ actualtype->tp_size <= word_size
+ )
+ )
+ )
||
( IsConformantArray(formaltype)
&&
&& TstTypeEquiv(formaltype->arr_elem, char_type)
)
)
- );
+ )
+ ||
+ ( VARflag && OldCompat(formaltype, actualtype, nd))
+ ;
+}
+
+int
+OldCompat(ft, at, nd)
+ struct type *ft, *at;
+ struct node *nd;
+{
+ if (TstCompat(ft, at)) {
+node_warning(nd, "oldfashioned! types of formal and actual must be identical");
+ return 1;
+ }
+
+ return 0;
}
{
static label filename_label = 0;
- if (options['p']) {
+ if (! options['L']) {
if (!filename_label) {
filename_label = data_label();
C_df_dlb(filename_label);
return;
}
- if (options['p']) C_lin((arith) nd->nd_lineno);
+ if (options['L']) C_lin((arith) nd->nd_lineno);
if (nd->nd_class == Call) {
- if (chk_call(nd)) CodeCall(nd);
+ if (chk_call(nd)) {
+ if (nd->nd_type != 0) {
+ node_error(nd, "procedure call expected");
+ return;
+ }
+ CodeCall(nd);
+ }
return;
}
switch(nd->nd_symb) {
case BECOMES:
- DoAssign(nd, left, right, 0);
+ DoAssign(nd, left, right);
break;
case IF:
struct node *fnd;
label l1 = instructionlabel++;
label l2 = instructionlabel++;
- arith incr = 1;
arith size;
- assert(left->nd_symb == TO);
- assert(left->nd_left->nd_symb == BECOMES);
-
- DoAssign(left->nd_left,
- left->nd_left->nd_left,
- left->nd_left->nd_right, 1);
+ if (! DoForInit(nd, left)) break;
fnd = left->nd_right;
- if (fnd->nd_symb == BY) {
- incr = fnd->nd_left->nd_INT;
- fnd = fnd->nd_right;
- }
- if (! chk_expr(fnd)) return;
size = fnd->nd_type->tp_size;
if (fnd->nd_class != Value) {
- *pds = InitDesig;
- CodeExpr(fnd, pds, NO_LABEL, NO_LABEL);
- CodeValue(pds, size);
+ CodePExpr(fnd);
tmp = NewInt();
C_stl(tmp);
}
- if (!TstCompat(left->nd_left->nd_left->nd_type,
- fnd->nd_type)) {
-node_error(fnd, "type incompatibility in limit of FOR loop");
- break;
- }
C_bra(l1);
C_df_ilb(l2);
WalkNode(right, lab);
- *pds = InitDesig;
- C_loc(incr);
- CodeDesig(left->nd_left->nd_left, pds);
- CodeValue(pds, size);
+ C_loc(left->nd_INT);
+ CodePExpr(nd);
C_adi(int_size);
- *pds = InitDesig;
- CodeDesig(left->nd_left->nd_left, pds);
- CodeStore(pds, size);
+ CodeDStore(nd);
C_df_ilb(l1);
- *pds = InitDesig;
- CodeDesig(left->nd_left->nd_left, pds);
- CodeValue(pds, size);
+ CodePExpr(nd);
if (tmp) C_lol(tmp); else C_loc(fnd->nd_INT);
- if (incr > 0) {
+ if (left->nd_INT > 0) {
C_ble(l2);
}
else C_bge(l2);
case RETURN:
if (right) {
WalkExpr(right, NO_LABEL, NO_LABEL);
- /* What kind of compatibility do we need here ???
- assignment compatibility?
+ /* Assignment compatibility? Yes, see Rep. 9.11
*/
if (!TstAssCompat(func_type, right->nd_type)) {
node_error(right, "type incompatibility in RETURN statement");
Desig = InitDesig;
CodeDesig(nd, &Desig);
+}
+
+DoForInit(nd, left)
+ register struct node *nd, *left;
+{
+ nd->nd_left = nd->nd_right = 0;
+ nd->nd_class = Name;
+ nd->nd_symb = IDENT;
+
+ if (! chk_designator(nd, VARIABLE, D_DEFINED) ||
+ ! chk_expr(left->nd_left) ||
+ ! chk_expr(left->nd_right)) return;
+
+ if (nd->nd_type->tp_size > word_size ||
+ !(nd->nd_type->tp_fund & T_DISCRETE)) {
+ node_error(nd, "illegal type of FOR loop variable");
+ return 0;
+ }
+
+ if (!TstCompat(nd->nd_type, left->nd_left->nd_type) ||
+ !TstCompat(nd->nd_type, left->nd_right->nd_type)) {
+ if (!TstAssCompat(nd->nd_type, left->nd_left->nd_type) ||
+ !TstAssCompat(nd->nd_type, left->nd_right->nd_type)) {
+ node_error(nd, "type incompatibility in FOR statement");
+ return 0;
+ }
+node_warning(nd, "old-fashioned! compatibility required in FOR statement");
+ }
+
+ CodePExpr(left->nd_left);
+ CodeDStore(nd);
}
-DoAssign(nd, left, right, forloopass)
+DoAssign(nd, left, right)
struct node *nd;
register struct node *left, *right;
{
- /* May we do it in this order (expression first) ??? */
+ /* May we do it in this order (expression first) ??? */
struct desig ds;
WalkExpr(right, NO_LABEL, NO_LABEL);
if (! chk_designator(left, DESIGNATOR|VARIABLE, D_DEFINED)) return;
- if (forloopass) {
- if (! TstCompat(left->nd_type, right->nd_type)) {
- node_error(nd, "type incompatibility in FOR loop");
- return;
- }
- /* Test if the left hand side may be a for loop variable ??? */
- }
- else if (! TstAssCompat(left->nd_type, right->nd_type)) {
+ if (! TstAssCompat(left->nd_type, right->nd_type)) {
node_error(nd, "type incompatibility in assignment");
return;
}
public / ack.git / commitdiff