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

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

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

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

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

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

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