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

Several minor mods: simplifications and identifier name changes

Browse source
This commit is contained in:
ceriel 1991-03-18 16:30:49 +00:00
parent 22378eaff8
commit 5a53ba3f50
6 changed files with 207 additions and 222 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -149,9 +149,14 @@ MkCoercion(pnd, tp)
return; return;
} }
} }
*pnd = nd = MkNode(Uoper, NULLNODE, nd, &(nd->nd_token)); *pnd = nd;
nd = getnode(Uoper);
nd->nd_symb = COERCION; nd->nd_symb = COERCION;
nd->nd_type = tp; nd->nd_type = tp;
nd->nd_LEFT = NULLNODE;
nd->nd_RIGHT = *pnd;
nd->nd_lineno = (*pnd)->nd_lineno;
*pnd = nd;
} }
int int
@ -1104,8 +1109,8 @@ ChkStandard(expp)
/* Check a call of a standard procedure or function /* Check a call of a standard procedure or function
*/ */
register t_node *exp = *expp; register t_node *exp = *expp;
t_node *arg = exp; t_node *arglink = exp;
register t_node *left; register t_node *arg;
register t_def *edf = exp->nd_LEFT->nd_def; register t_def *edf = exp->nd_LEFT->nd_def;
int free_it = 0; int free_it = 0;
int isconstant = 0; int isconstant = 0;
@ -1115,17 +1120,17 @@ ChkStandard(expp)
exp->nd_type = error_type; exp->nd_type = error_type;
switch(edf->df_value.df_stdname) { switch(edf->df_value.df_stdname) {
case S_ABS: case S_ABS:
if (!(left = getarg(&arg, T_NUMERIC, 0, edf))) return 0; if (!(arg = getarg(&arglink, T_NUMERIC, 0, edf))) return 0;
exp->nd_type = BaseType(left->nd_type); exp->nd_type = BaseType(arg->nd_type);
MkCoercion(&(arg->nd_LEFT), exp->nd_type); MkCoercion(&(arglink->nd_LEFT), exp->nd_type);
left = arg->nd_LEFT; arg = arglink->nd_LEFT;
if (! (exp->nd_type->tp_fund & (T_INTEGER|T_REAL))) { if (! (exp->nd_type->tp_fund & (T_INTEGER|T_REAL))) {
free_it = 1; free_it = 1;
} }
if (left->nd_class == Value) { if (arg->nd_class == Value) {
switch(exp->nd_type->tp_fund) { switch(exp->nd_type->tp_fund) {
case T_REAL: case T_REAL:
left->nd_RVAL.flt_sign = 0; arg->nd_RVAL.flt_sign = 0;
free_it = 1; free_it = 1;
break; break;
case T_INTEGER: case T_INTEGER:
@ -1137,13 +1142,14 @@ ChkStandard(expp)
case S_CAP: case S_CAP:
exp->nd_type = char_type; exp->nd_type = char_type;
if (!(left = getarg(&arg, T_CHAR, 0, edf))) return 0; if (!(arg = getarg(&arglink, T_CHAR, 0, edf))) return 0;
if (left->nd_class == Value) isconstant = 1; if (arg->nd_class == Value) isconstant = 1;
break; break;
case S_FLOATD: case S_FLOATD:
case S_FLOAT: case S_FLOAT:
if (! getarg(&arg, T_INTORCARD, 0, edf)) return 0; if (! getarg(&arglink, T_INTORCARD, 0, edf)) return 0;
arg = arglink;
if (edf->df_value.df_stdname == S_FLOAT) { if (edf->df_value.df_stdname == S_FLOAT) {
MkCoercion(&(arg->nd_LEFT), card_type); MkCoercion(&(arg->nd_LEFT), card_type);
} }
@ -1159,10 +1165,10 @@ ChkStandard(expp)
t_type *tp; t_type *tp;
t_type *s1, *s2, *d1, *d2; t_type *s1, *s2, *d1, *d2;
if (!(left = getarg(&arg, 0, 0, edf))) { if (!(arg = getarg(&arglink, 0, 0, edf))) {
return 0; return 0;
} }
tp = BaseType(left->nd_type); tp = BaseType(arg->nd_type);
if (edf->df_value.df_stdname == S_SHORT) { if (edf->df_value.df_stdname == S_SHORT) {
s1 = longint_type; s1 = longint_type;
@ -1178,13 +1184,13 @@ ChkStandard(expp)
} }
if (tp == s1) { if (tp == s1) {
MkCoercion(&(arg->nd_LEFT), d1); MkCoercion(&(arglink->nd_LEFT), d1);
} }
else if (tp == s2) { else if (tp == s2) {
MkCoercion(&(arg->nd_LEFT), d2); MkCoercion(&(arglink->nd_LEFT), d2);
} }
else { else {
df_error(left, "unexpected parameter type", edf); df_error(arg, "unexpected parameter type", edf);
break; break;
} }
free_it = 1; free_it = 1;
@ -1192,30 +1198,30 @@ ChkStandard(expp)
} }
case S_HIGH: case S_HIGH:
if (!(left = getarg(&arg, T_ARRAY|T_STRING|T_CHAR, 0, edf))) { if (!(arg = getarg(&arglink, T_ARRAY|T_STRING|T_CHAR, 0, edf))) {
return 0; return 0;
} }
if (left->nd_type->tp_fund == T_ARRAY) { if (arg->nd_type->tp_fund == T_ARRAY) {
exp->nd_type = IndexType(left->nd_type); exp->nd_type = IndexType(arg->nd_type);
if (! IsConformantArray(left->nd_type)) { if (! IsConformantArray(arg->nd_type)) {
left->nd_type = exp->nd_type; arg->nd_type = exp->nd_type;
isconstant = 1; isconstant = 1;
} }
break; break;
} }
if (left->nd_symb != STRING) { if (arg->nd_symb != STRING) {
df_error(left,"array parameter expected", edf); df_error(arg,"array parameter expected", edf);
return 0; return 0;
} }
exp = getnode(Value); exp = getnode(Value);
exp->nd_type = card_type; exp->nd_type = card_type;
/* Notice that we could disallow HIGH("") here by checking /* Notice that we could disallow HIGH("") here by checking
that left->nd_type->tp_fund != T_CHAR || left->nd_INT != 0. that arg->nd_type->tp_fund != T_CHAR || arg->nd_INT != 0.
??? For the time being, we don't. !!! ??? For the time being, we don't. !!!
Maybe the empty string should not be allowed at all. Maybe the empty string should not be allowed at all.
*/ */
exp->nd_INT = left->nd_type->tp_fund == T_CHAR ? 0 : exp->nd_INT = arg->nd_type->tp_fund == T_CHAR ? 0 :
left->nd_SLE - 1; arg->nd_SLE - 1;
exp->nd_symb = INTEGER; exp->nd_symb = INTEGER;
exp->nd_lineno = (*expp)->nd_lineno; exp->nd_lineno = (*expp)->nd_lineno;
(*expp)->nd_RIGHT = 0; (*expp)->nd_RIGHT = 0;
@ -1225,25 +1231,25 @@ ChkStandard(expp)
case S_MAX: case S_MAX:
case S_MIN: case S_MIN:
if (!(left = getname(&arg, D_ISTYPE, T_DISCRETE, edf))) { if (!(arg = getname(&arglink, D_ISTYPE, T_DISCRETE, edf))) {
return 0; return 0;
} }
exp->nd_type = left->nd_type; exp->nd_type = arg->nd_type;
isconstant = 1; isconstant = 1;
break; break;
case S_ODD: case S_ODD:
if (! (left = getarg(&arg, T_INTORCARD, 0, edf))) return 0; if (! (arg = getarg(&arglink, T_INTORCARD, 0, edf))) return 0;
MkCoercion(&(arg->nd_LEFT), BaseType(left->nd_type)); MkCoercion(&(arglink->nd_LEFT), BaseType(arg->nd_type));
exp->nd_type = bool_type; exp->nd_type = bool_type;
if (arg->nd_LEFT->nd_class == Value) isconstant = 1; if (arglink->nd_LEFT->nd_class == Value) isconstant = 1;
break; break;
case S_ORD: case S_ORD:
if (! (left = getarg(&arg, T_NOSUB, 0, edf))) return 0; if (! (arg = getarg(&arglink, T_NOSUB, 0, edf))) return 0;
exp->nd_type = card_type; exp->nd_type = card_type;
if (left->nd_class == Value) { if (arg->nd_class == Value) {
left->nd_type = card_type; arg->nd_type = card_type;
free_it = 1; free_it = 1;
} }
break; break;
@ -1262,56 +1268,55 @@ ChkStandard(expp)
node_error(exp, "NEW and DISPOSE are obsolete"); node_error(exp, "NEW and DISPOSE are obsolete");
} }
} }
left = getvariable(&arg, edf, D_USED|D_DEFINED);
exp->nd_type = 0; exp->nd_type = 0;
if (! left) return 0; arg = getvariable(&arglink, edf, D_USED|D_DEFINED);
if (! (left->nd_type->tp_fund == T_POINTER)) { if (! arg) return 0;
df_error(left, "pointer variable expected", edf); if (! (arg->nd_type->tp_fund == T_POINTER)) {
df_error(arg, "pointer variable expected", edf);
return 0; return 0;
} }
/* Now, make it look like a call to ALLOCATE or DEALLOCATE */ /* Now, make it look like a call to ALLOCATE or DEALLOCATE */
{ arglink->nd_RIGHT = arg = getnode(Link);
left = getnode(Value); arg->nd_lineno = exp->nd_lineno;
arg->nd_symb = ',';
arg->nd_LEFT = getnode(Value);
arg = arg->nd_LEFT;
arg->nd_INT = PointedtoType(arglink->nd_LEFT->nd_type)->tp_size;
arg->nd_symb = INTEGER;
arg->nd_lineno = exp->nd_lineno;
arg->nd_type = card_type;
/* Ignore other arguments to NEW and/or DISPOSE ??? */
left->nd_INT = PointedtoType(arg->nd_LEFT->nd_type)->tp_size; FreeNode(exp->nd_LEFT);
left->nd_symb = INTEGER; exp->nd_LEFT = arg = getnode(Name);
left->nd_lineno = exp->nd_lineno; arg->nd_symb = IDENT;
left->nd_type = card_type; arg->nd_lineno = exp->nd_lineno;
arg->nd_RIGHT = MkNode(Link, left, NULLNODE, &(left->nd_token)); arg->nd_IDF = str2idf(edf->df_value.df_stdname==S_NEW ?
arg->nd_RIGHT->nd_symb = ','; "ALLOCATE" : "DEALLOCATE", 0);
/* Ignore other arguments to NEW and/or DISPOSE ??? */
FreeNode(exp->nd_LEFT);
exp->nd_LEFT = left = getnode(Name);
left->nd_symb = IDENT;
left->nd_lineno = exp->nd_lineno;
left->nd_IDF = str2idf(edf->df_value.df_stdname==S_NEW ?
"ALLOCATE" : "DEALLOCATE", 0);
}
return ChkCall(expp); return ChkCall(expp);
#endif #endif
case S_TSIZE: /* ??? */ case S_TSIZE: /* ??? */
case S_SIZE: case S_SIZE:
exp->nd_type = intorcard_type; exp->nd_type = intorcard_type;
if (!(left = getname(&arg,D_FIELD|D_VARIABLE|D_ISTYPE,0,edf))) { if (!(arg = getname(&arglink,D_FIELD|D_VARIABLE|D_ISTYPE,0,edf))) {
return 0; return 0;
} }
if (! IsConformantArray(left->nd_type)) isconstant = 1; if (! IsConformantArray(arg->nd_type)) isconstant = 1;
#ifndef NOSTRICT #ifndef NOSTRICT
else node_warning(exp, else node_warning(exp,
W_STRICT, W_STRICT,
"%s on conformant array", "%s on conformant array",
exp->nd_LEFT->nd_def->df_idf->id_text); edf->df_idf->id_text);
#endif #endif
#ifndef STRICT_3RD_ED #ifndef STRICT_3RD_ED
if (! options['3'] && edf->df_value.df_stdname == S_TSIZE) { if (! options['3'] && edf->df_value.df_stdname == S_TSIZE) {
if (left = arg->nd_RIGHT) { if (arg = arglink->nd_RIGHT) {
node_warning(left, node_warning(arg,
W_OLDFASHIONED, W_OLDFASHIONED,
"TSIZE with multiple parameters, only first parameter used"); "TSIZE with multiple parameters, only first parameter used");
FreeNode(left); FreeNode(arg);
arg->nd_RIGHT = 0; arglink->nd_RIGHT = 0;
} }
} }
#endif #endif
@ -1319,49 +1324,49 @@ ChkStandard(expp)
case S_TRUNCD: case S_TRUNCD:
case S_TRUNC: case S_TRUNC:
if (! getarg(&arg, T_REAL, 0, edf)) return 0; if (! getarg(&arglink, T_REAL, 0, edf)) return 0;
MkCoercion(&(arg->nd_LEFT), MkCoercion(&(arglink->nd_LEFT),
edf->df_value.df_stdname == S_TRUNCD ? edf->df_value.df_stdname == S_TRUNCD ?
longint_type : card_type); longint_type : card_type);
free_it = 1; free_it = 1;
break; break;
case S_VAL: case S_VAL:
if (!(left = getname(&arg, D_ISTYPE, T_NOSUB, edf))) { if (!(arg = getname(&arglink, D_ISTYPE, T_NOSUB, edf))) {
return 0; return 0;
} }
exp->nd_type = left->nd_def->df_type; exp->nd_type = arg->nd_def->df_type;
exp->nd_RIGHT = arg->nd_RIGHT; exp->nd_RIGHT = arglink->nd_RIGHT;
arg->nd_RIGHT = 0; arglink->nd_RIGHT = 0;
FreeNode(arg); FreeNode(arglink);
arg = exp; arglink = exp;
/* fall through */ /* fall through */
case S_CHR: case S_CHR:
if (! getarg(&arg, T_CARDINAL, 0, edf)) return 0; if (! getarg(&arglink, T_CARDINAL, 0, edf)) return 0;
if (edf->df_value.df_stdname == S_CHR) { if (edf->df_value.df_stdname == S_CHR) {
exp->nd_type = char_type; exp->nd_type = char_type;
} }
if (exp->nd_type != int_type) { if (exp->nd_type != int_type) {
MkCoercion(&(arg->nd_LEFT), exp->nd_type); MkCoercion(&(arglink->nd_LEFT), exp->nd_type);
free_it = 1; free_it = 1;
} }
break; break;
case S_ADR: case S_ADR:
exp->nd_type = address_type; exp->nd_type = address_type;
if (! getarg(&arg, 0, 1, edf)) return 0; if (! getarg(&arglink, 0, 1, edf)) return 0;
break; break;
case S_DEC: case S_DEC:
case S_INC: case S_INC:
exp->nd_type = 0; exp->nd_type = 0;
if (! (left = getvariable(&arg, edf, D_USED|D_DEFINED))) return 0; if (! (arg = getvariable(&arglink, edf, D_USED|D_DEFINED))) return 0;
if (! (left->nd_type->tp_fund & T_DISCRETE)) { if (! (arg->nd_type->tp_fund & T_DISCRETE)) {
df_error(left,"illegal parameter type", edf); df_error(arg,"illegal parameter type", edf);
return 0; return 0;
} }
if (arg->nd_RIGHT) { if (arglink->nd_RIGHT) {
if (! getarg(&arg, T_INTORCARD, 0, edf)) return 0; if (! getarg(&arglink, T_INTORCARD, 0, edf)) return 0;
} }
break; break;
@ -1376,13 +1381,13 @@ ChkStandard(expp)
t_node *dummy; t_node *dummy;
exp->nd_type = 0; exp->nd_type = 0;
if (!(left = getvariable(&arg, edf, D_USED|D_DEFINED))) return 0; if (!(arg = getvariable(&arglink, edf, D_USED|D_DEFINED))) return 0;
tp = left->nd_type; tp = arg->nd_type;
if (tp->tp_fund != T_SET) { if (tp->tp_fund != T_SET) {
df_error(arg, "SET parameter expected", edf); df_error(arg, "SET parameter expected", edf);
return 0; return 0;
} }
if (!(dummy = getarg(&arg, 0, 0, edf))) return 0; if (!(dummy = getarg(&arglink, 0, 0, edf))) return 0;
if (!ChkAssCompat(&dummy, ElementType(tp), "EXCL/INCL")) { if (!ChkAssCompat(&dummy, ElementType(tp), "EXCL/INCL")) {
/* What type of compatibility do we want here? /* What type of compatibility do we want here?
apparently assignment compatibility! ??? ??? apparently assignment compatibility! ??? ???
@ -1392,7 +1397,7 @@ ChkStandard(expp)
*/ */
return 0; return 0;
} }
MkCoercion(&(arg->nd_LEFT), word_type); MkCoercion(&(arglink->nd_LEFT), word_type);
break; break;
} }
@ -1400,6 +1405,8 @@ ChkStandard(expp)
crash("(ChkStandard)"); crash("(ChkStandard)");
} }
arg = arglink;
if (arg->nd_RIGHT) { if (arg->nd_RIGHT) {
df_error(arg->nd_RIGHT, "too many parameters supplied", edf); df_error(arg->nd_RIGHT, "too many parameters supplied", edf);
return 0; return 0;

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

@ -32,8 +32,6 @@
#include "walk.h" #include "walk.h"
#include "bigresult.h" #include "bigresult.h"
extern char *long2str();
extern char *symbol2str();
extern int proclevel; extern int proclevel;
extern char options[]; extern char options[];
extern t_desig null_desig; extern t_desig null_desig;
@ -54,12 +52,6 @@ CodeConst(cst, size)
} }
else { else {
crash("(CodeConst)"); crash("(CodeConst)");
/*
C_df_dlb(++data_label);
C_rom_icon(long2str((long) cst), (arith) size);
c_lae_dlb(data_label);
C_loi((arith) size);
*/
} }
} }
@ -169,11 +161,11 @@ CodeExpr(nd, ds, true_label, false_label)
} }
CodeCoercion(t1, t2) CodeCoercion(t1, t2)
register t_type *t1, *t2; t_type *t1, *t2;
{ {
register int fund1, fund2; int fund1, fund2;
arith sz1 = t1->tp_size; int sz1 = t1->tp_size;
arith sz2; int sz2;
t1 = BaseType(t1); t1 = BaseType(t1);
t2 = BaseType(t2); t2 = BaseType(t2);
@ -186,7 +178,7 @@ CodeCoercion(t1, t2)
case T_ENUMERATION: case T_ENUMERATION:
case T_CARDINAL: case T_CARDINAL:
case T_INTORCARD: case T_INTORCARD:
if ((int) sz1 < (int) word_size) sz1 = word_size; if (sz1 < (int) word_size) sz1 = word_size;
/* fall through */ /* fall through */
case T_EQUAL: case T_EQUAL:
case T_POINTER: case T_POINTER:
@ -209,87 +201,76 @@ CodeCoercion(t1, t2)
switch(fund1) { switch(fund1) {
case T_INTEGER: case T_INTEGER:
if ((int) sz1 < (int) word_size) { if (sz1 < (int) word_size) {
c_loc((int)sz1); c_loc(sz1);
c_loc((int) word_size); c_loc((int) word_size);
C_cii(); C_cii();
sz1 = word_size; sz1 = word_size;
} }
if (fund2 == T_REAL) { c_loc(sz1);
c_loc((int)sz1); c_loc(sz2);
c_loc((int)sz2); switch(fund2) {
case T_REAL:
C_cif(); C_cif();
break; break;
} case T_INTEGER:
if ((int) sz2 != (int) sz1) { C_cii();
c_loc((int)sz1); break;
c_loc((int)sz2); case T_CARDINAL:
switch(fund2) { C_ciu();
case T_INTEGER: break;
C_cii(); default:
break; crash("Funny integer conversion");
case T_CARDINAL:
C_ciu();
break;
default:
crash("Funny integer conversion");
}
} }
break; break;
case T_CARDINAL: case T_CARDINAL:
case T_INTORCARD: case T_INTORCARD:
if (fund2 == T_REAL) { c_loc(sz1);
c_loc((int)sz1); c_loc(sz2);
c_loc((int)sz2); switch(fund2) {
case T_REAL:
C_cuf(); C_cuf();
break; break;
} case T_CARDINAL:
if ((int) sz1 != (int) sz2) { case T_INTORCARD:
c_loc((int)sz1); C_cuu();
c_loc((int)sz2); break;
switch(fund2) { case T_INTEGER:
case T_CARDINAL: C_cui();
case T_INTORCARD: break;
C_cuu(); default:
break; crash("Funny cardinal conversion");
case T_INTEGER:
C_cui();
break;
default:
crash("Funny cardinal conversion");
}
} }
break; break;
case T_REAL: case T_REAL:
switch(fund2) { switch(fund2) {
case T_REAL: case T_REAL:
if ((int) sz1 != (int) sz2) { c_loc(sz1);
c_loc((int)sz1); c_loc(sz2);
c_loc((int)sz2); C_cff();
C_cff();
}
break; break;
case T_INTEGER: case T_INTEGER:
c_loc((int)sz1); c_loc(sz1);
c_loc((int)sz2); c_loc(sz2);
C_cfi(); C_cfi();
break; break;
case T_CARDINAL: case T_CARDINAL:
if (! options['R']) { if (! options['R']) {
label lb = ++text_label; label lb = ++text_label;
arith asz1 = sz1;
C_dup(sz1); C_dup(asz1);
C_zrf(sz1); C_zrf(asz1);
C_cmf(sz1); C_cmf(asz1);
C_zge(lb); C_zge(lb);
c_loc(ECONV); c_loc(ECONV);
C_trp(); C_trp();
def_ilb(lb); def_ilb(lb);
} }
c_loc((int)sz1); c_loc(sz1);
c_loc((int)sz2); c_loc(sz2);
C_cfu(); C_cfu();
break; break;
default: default:
@ -332,6 +313,7 @@ CodeCall(nd)
register t_def *df = left->nd_def; register t_def *df = left->nd_def;
if (df->df_kind == D_CONST) { if (df->df_kind == D_CONST) {
/* a procedure address */
df = df->con_const.tk_data.tk_def; df = df->con_const.tk_data.tk_def;
} }
if (df->df_kind & (D_PROCEDURE|D_PROCHEAD)) { if (df->df_kind & (D_PROCEDURE|D_PROCHEAD)) {
@ -392,12 +374,12 @@ CodeParameters(param, arg)
ARRAY OF (WORD|BYTE) ARRAY OF (WORD|BYTE)
*/ */
C_loc(arg_type->arr_elem->tp_size); C_loc(arg_type->arr_elem->tp_size);
C_mli(word_size); C_mlu(word_size);
if (elem == word_type) { if (elem == word_type) {
c_loc((int) word_size - 1); c_loc((int) word_size - 1);
C_adi(word_size); C_adu(word_size);
c_loc((int) word_size); c_loc((int) word_size - 1);
C_dvi(word_size); C_and(word_size);
} }
else { else {
assert(elem == byte_type); assert(elem == byte_type);
@ -430,10 +412,11 @@ CodeParameters(param, arg)
break; break;
default:{ default:{
arith tmp, TmpSpace(); arith tmp, TmpSpace();
arith sz = WA(arg->nd_type->tp_size);
CodePExpr(arg); CodePExpr(arg);
tmp = TmpSpace(arg->nd_type->tp_size, arg->nd_type->tp_align); tmp = TmpSpace(sz, arg->nd_type->tp_align);
STL(tmp, WA(arg->nd_type->tp_size)); STL(tmp, sz);
C_lal(tmp); C_lal(tmp);
} }
break; break;
@ -535,7 +518,7 @@ CodeStd(nd)
case S_ODD: case S_ODD:
CodePExpr(left); CodePExpr(left);
if (tp->tp_size == word_size) { if ((int) tp->tp_size == (int) word_size) {
c_loc(1); c_loc(1);
C_and(word_size); C_and(word_size);
} }
@ -667,17 +650,18 @@ CodeOper(expr, true_label, false_label)
{ {
register t_node *leftop = expr->nd_LEFT; register t_node *leftop = expr->nd_LEFT;
register t_node *rightop = expr->nd_RIGHT; register t_node *rightop = expr->nd_RIGHT;
register t_type *tp = expr->nd_type; int fund = expr->nd_type->tp_fund;
arith size = expr->nd_type->tp_size;
switch (expr->nd_symb) { switch (expr->nd_symb) {
case '+': case '+':
Operands(expr); Operands(expr);
switch (tp->tp_fund) { switch (fund) {
case T_INTEGER: case T_INTEGER:
C_adi(tp->tp_size); C_adi(size);
break; break;
case T_REAL: case T_REAL:
C_adf(tp->tp_size); C_adf(size);
break; break;
case T_POINTER: case T_POINTER:
case T_EQUAL: case T_EQUAL:
@ -685,10 +669,10 @@ CodeOper(expr, true_label, false_label)
break; break;
case T_CARDINAL: case T_CARDINAL:
case T_INTORCARD: case T_INTORCARD:
addu((int) tp->tp_size); addu((int) size);
break; break;
case T_SET: case T_SET:
C_ior(tp->tp_size); C_ior(size);
break; break;
default: default:
crash("bad type +"); crash("bad type +");
@ -696,17 +680,17 @@ CodeOper(expr, true_label, false_label)
break; break;
case '-': case '-':
Operands(expr); Operands(expr);
switch (tp->tp_fund) { switch (fund) {
case T_INTEGER: case T_INTEGER:
C_sbi(tp->tp_size); C_sbi(size);
break; break;
case T_REAL: case T_REAL:
C_sbf(tp->tp_size); C_sbf(size);
break; break;
case T_POINTER: case T_POINTER:
case T_EQUAL: case T_EQUAL:
if (rightop->nd_type == address_type) { if (rightop->nd_type == address_type) {
C_sbs(tp->tp_size); C_sbs(size);
break; break;
} }
C_ngi(rightop->nd_type->tp_size); C_ngi(rightop->nd_type->tp_size);
@ -714,11 +698,11 @@ CodeOper(expr, true_label, false_label)
break; break;
case T_INTORCARD: case T_INTORCARD:
case T_CARDINAL: case T_CARDINAL:
subu((int) tp->tp_size); subu((int) size);
break; break;
case T_SET: case T_SET:
C_com(tp->tp_size); C_com(size);
C_and(tp->tp_size); C_and(size);
break; break;
default: default:
crash("bad type -"); crash("bad type -");
@ -726,26 +710,26 @@ CodeOper(expr, true_label, false_label)
break; break;
case '*': case '*':
Operands(expr); Operands(expr);
switch (tp->tp_fund) { switch (fund) {
case T_INTEGER: case T_INTEGER:
C_mli(tp->tp_size); C_mli(size);
break; break;
case T_POINTER: case T_POINTER:
case T_EQUAL: case T_EQUAL:
case T_CARDINAL: case T_CARDINAL:
case T_INTORCARD: case T_INTORCARD:
if (! options['R']) { if (! options['R']) {
C_cal((int)(tp->tp_size) <= (int)word_size ? C_cal((int)(size) <= (int)word_size ?
"muluchk" : "muluchk" :
"mululchk"); "mululchk");
} }
C_mlu(tp->tp_size); C_mlu(size);
break; break;
case T_REAL: case T_REAL:
C_mlf(tp->tp_size); C_mlf(size);
break; break;
case T_SET: case T_SET:
C_and(tp->tp_size); C_and(size);
break; break;
default: default:
crash("bad type *"); crash("bad type *");
@ -753,12 +737,12 @@ CodeOper(expr, true_label, false_label)
break; break;
case '/': case '/':
Operands(expr); Operands(expr);
switch (tp->tp_fund) { switch (fund) {
case T_REAL: case T_REAL:
C_dvf(tp->tp_size); C_dvf(size);
break; break;
case T_SET: case T_SET:
C_xor(tp->tp_size); C_xor(size);
break; break;
default: default:
crash("bad type /"); crash("bad type /");
@ -766,19 +750,19 @@ CodeOper(expr, true_label, false_label)
break; break;
case DIV: case DIV:
Operands(expr); Operands(expr);
switch(tp->tp_fund) { switch(fund) {
case T_INTEGER: case T_INTEGER:
C_cal((int)(tp->tp_size) == (int)word_size C_cal((int)(size) == (int)word_size
? "dvi" ? "dvi"
: "dvil"); : "dvil");
C_asp(2*tp->tp_size); C_asp(2*size);
C_lfr(tp->tp_size); C_lfr(size);
break; break;
case T_POINTER: case T_POINTER:
case T_EQUAL: case T_EQUAL:
case T_CARDINAL: case T_CARDINAL:
case T_INTORCARD: case T_INTORCARD:
C_dvu(tp->tp_size); C_dvu(size);
break; break;
default: default:
crash("bad type DIV"); crash("bad type DIV");
@ -786,19 +770,19 @@ CodeOper(expr, true_label, false_label)
break; break;
case MOD: case MOD:
Operands(expr); Operands(expr);
switch(tp->tp_fund) { switch(fund) {
case T_INTEGER: case T_INTEGER:
C_cal((int)(tp->tp_size) == (int)word_size C_cal((int)(size) == (int)word_size
? "rmi" ? "rmi"
: "rmil"); : "rmil");
C_asp(2*tp->tp_size); C_asp(2*size);
C_lfr(tp->tp_size); C_lfr(size);
break; break;
case T_POINTER: case T_POINTER:
case T_EQUAL: case T_EQUAL:
case T_CARDINAL: case T_CARDINAL:
case T_INTORCARD: case T_INTORCARD:
C_rmu(tp->tp_size); C_rmu(size);
break; break;
default: default:
crash("bad type MOD"); crash("bad type MOD");
@ -809,13 +793,16 @@ CodeOper(expr, true_label, false_label)
case '>': case '>':
case GREATEREQUAL: case GREATEREQUAL:
case '=': case '=':
case '#': case '#': {
t_type *tp;
Operands(expr); Operands(expr);
tp = BaseType(leftop->nd_type); tp = BaseType(leftop->nd_type);
if (tp == intorcard_type) tp = BaseType(rightop->nd_type); if (tp == intorcard_type) tp = BaseType(rightop->nd_type);
size = tp->tp_size;
switch (tp->tp_fund) { switch (tp->tp_fund) {
case T_INTEGER: case T_INTEGER:
C_cmi(tp->tp_size); C_cmi(size);
break; break;
case T_POINTER: case T_POINTER:
case T_HIDDEN: case T_HIDDEN:
@ -824,33 +811,33 @@ CodeOper(expr, true_label, false_label)
break; break;
case T_CARDINAL: case T_CARDINAL:
case T_INTORCARD: case T_INTORCARD:
C_cmu(tp->tp_size); C_cmu(size);
break; break;
case T_ENUMERATION: case T_ENUMERATION:
case T_CHAR: case T_CHAR:
C_cmu(word_size); C_cmu(word_size);
break; break;
case T_REAL: case T_REAL:
C_cmf(tp->tp_size); C_cmf(size);
break; break;
case T_SET: case T_SET:
if (expr->nd_symb == GREATEREQUAL) { if (expr->nd_symb == GREATEREQUAL) {
/* A >= B is the same as A equals A + B /* A >= B is the same as A equals A + B
*/ */
C_dup(tp->tp_size << 1); C_dup(size << 1);
C_asp(tp->tp_size); C_asp(size);
C_ior(tp->tp_size); C_ior(size);
expr->nd_symb = '='; expr->nd_symb = '=';
} }
else if (expr->nd_symb == LESSEQUAL) { else if (expr->nd_symb == LESSEQUAL) {
/* A <= B is the same as A - B = {} /* A <= B is the same as A - B = {}
*/ */
C_com(tp->tp_size); C_com(size);
C_and(tp->tp_size); C_and(size);
C_zer(tp->tp_size); C_zer(size);
expr->nd_symb = '='; expr->nd_symb = '=';
} }
C_cms(tp->tp_size); C_cms(size);
break; break;
default: default:
crash("bad type COMPARE"); crash("bad type COMPARE");
@ -862,6 +849,7 @@ CodeOper(expr, true_label, false_label)
} }
truthvalue(expr->nd_symb); truthvalue(expr->nd_symb);
break; break;
}
case IN: case IN:
/* In this case, evaluate right hand side first! The /* In this case, evaluate right hand side first! The
@ -909,7 +897,7 @@ CodeOper(expr, true_label, false_label)
break; break;
} }
default: default:
crash("(CodeOper) Bad operator %s\n",symbol2str(expr->nd_symb)); crash("(CodeOper) Bad operator");
} }
} }

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

@ -503,8 +503,9 @@ cstset(expp)
} }
set1 = exp->nd_LEFT->nd_set; set1 = exp->nd_LEFT->nd_set;
*expp = MkLeaf(Set, &(exp->nd_RIGHT->nd_token)); *expp = getnode(Set);
(*expp)->nd_type = exp->nd_type; (*expp)->nd_type = exp->nd_type;
(*expp)->nd_lineno = exp->nd_lineno;
switch(exp->nd_symb) { switch(exp->nd_symb) {
case '+': /* Set union */ case '+': /* Set union */
case '-': /* Set difference */ case '-': /* Set difference */

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

@ -362,7 +362,9 @@ ForwDef(ids, scope)
if (!(df = lookup(ids->nd_IDF, scope, 0, 0))) { if (!(df = lookup(ids->nd_IDF, scope, 0, 0))) {
df = define(ids->nd_IDF, scope, D_FORWARD); df = define(ids->nd_IDF, scope, D_FORWARD);
df->for_node = MkLeaf(Name, &(ids->nd_token)); df->for_node = new_node();
*(df->for_node) = *ids;
df->for_node->nd_NEXT = 0;
} }
return df; return df;
} }

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

@ -51,7 +51,7 @@ typedef struct node t_node;
/* ALLOCDEF "node" 50 */ /* ALLOCDEF "node" 50 */
extern t_node *MkNode(), *MkLeaf(), *dot2node(), *dot2leaf(), *getnode(); extern t_node *dot2node(), *dot2leaf(), *getnode();
#define NULLNODE ((t_node *) 0) #define NULLNODE ((t_node *) 0)

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

@ -50,33 +50,24 @@ getnode(class)
} }
t_node * t_node *
MkNode(class, left, right, token) dot2node(class, left, right)
t_node *left, *right; t_node *left, *right;
t_token *token;
{ {
/* Create a node and initialize it with the given parameters
*/
register t_node *nd = getnode(class); register t_node *nd = getnode(class);
nd->nd_token = *token; nd->nd_symb = dot.tk_symb;
nd->nd_lineno = dot.tk_lineno;
nd->nd_LEFT = left; nd->nd_LEFT = left;
nd->nd_RIGHT = right; nd->nd_RIGHT = right;
return nd; return nd;
} }
t_node * t_node *
dot2node(class, left, right) dot2leaf(class)
t_node *left, *right;
{
return MkNode(class, left, right, &dot);
}
t_node *
MkLeaf(class, token)
t_token *token;
{ {
register t_node *nd = getnode(class); register t_node *nd = getnode(class);
nd->nd_token = *token;
nd->nd_token = dot;
switch(nsubnodes[class]) { switch(nsubnodes[class]) {
case 1: case 1:
nd->nd_NEXT = 0; nd->nd_NEXT = 0;
@ -89,12 +80,6 @@ MkLeaf(class, token)
return nd; return nd;
} }
t_node *
dot2leaf(class)
{
return MkLeaf(class, &dot);
}
FreeNode(nd) FreeNode(nd)
register t_node *nd; register t_node *nd;
{ {
@ -114,16 +99,18 @@ FreeNode(nd)
free_node(nd); free_node(nd);
} }
/*ARGSUSED*/
NodeCrash(expp) NodeCrash(expp)
t_node *expp; t_node *expp;
{ {
crash("Illegal node %d", expp->nd_class); crash("(NodeCrash) Illegal node");
} }
/*ARGSUSED*/
PNodeCrash(expp) PNodeCrash(expp)
t_node **expp; t_node **expp;
{ {
crash("Illegal node %d", (*expp)->nd_class); crash("(PNodeCrash) Illegal node");
} }
#ifdef DEBUG #ifdef DEBUG