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

some minor changes and a fix in pointer arithmetic

Browse source
This commit is contained in:
ceriel 1988-04-06 18:14:50 +00:00
parent c255ffeaaa
commit c8a728969d
4 changed files with 59 additions and 49 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -1021,7 +1021,6 @@ ChkStandard(expp)
t_node *arg = expp;
register t_node *left = expp->nd_left;
register t_def *edf = left->nd_def;
t_type *basetype;
int free_it = 0;
assert(left->nd_class == Def);
@ -1030,17 +1029,19 @@ ChkStandard(expp)
switch(edf->df_value.df_stdname) {
case S_ABS:
if (!(left = getarg(&arg, T_NUMERIC, 0, edf))) return 0;
basetype = BaseType(left->nd_type);
MkCoercion(&(arg->nd_left), basetype);
left = arg->nd_left;
expp->nd_type = left->nd_type;
if (left->nd_class == Value &&
expp->nd_type->tp_fund != T_REAL) {
cstcall(expp, S_ABS);
}
else if (basetype->tp_fund != T_INTEGER &&
basetype->tp_fund != T_REAL) {
expp->nd_type = BaseType(left->nd_type);
MkCoercion(&(arg->nd_left), expp->nd_type);
switch(expp->nd_type->tp_fund) {
case T_REAL:
break;
case T_INTEGER:
if (arg->nd_left->nd_class == Value) {
cstcall(expp,S_ABS);
}
break;
default:
free_it = 1;
break;
}
break;
@ -1050,13 +1051,6 @@ ChkStandard(expp)
if (left->nd_class == Value) cstcall(expp, S_CAP);
break;
case S_CHR:
expp->nd_type = char_type;
if (!(left = getarg(&arg, T_INTORCARD, 0, edf))) return 0;
MkCoercion(&(arg->nd_left), char_type);
free_it = 1;
break;
case S_FLOATD:
case S_FLOAT:
if (! getarg(&arg, T_INTORCARD, 0, edf)) return 0;
@ -1152,9 +1146,13 @@ ChkStandard(expp)
break;
case S_ORD:
if (! getarg(&arg, T_DISCRETE, 0, edf)) return 0;
MkCoercion(&(arg->nd_left), card_type);
free_it = 1;
if (! (left = getarg(&arg, T_NOSUB, 0, edf))) return 0;
MkCoercion(&(arg->nd_left), BaseType(left->nd_type));
expp->nd_type = card_type;
if (arg->nd_left->nd_class == Value) {
arg->nd_left->nd_type = card_type;
free_it = 1;
}
break;
#ifndef STRICT_3RD_ED
@ -1220,17 +1218,15 @@ ChkStandard(expp)
case S_TRUNCD:
case S_TRUNC:
expp->nd_type = card_type;
if (edf->df_value.df_stdname == S_TRUNCD) {
expp->nd_type = longint_type;
}
if (! getarg(&arg, T_REAL, 0, edf)) return 0;
MkCoercion(&(arg->nd_left), expp->nd_type);
MkCoercion(&(arg->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_DISCRETE, edf))) {
if (!(left = getname(&arg, D_ISTYPE, T_NOSUB, edf))) {
return 0;
}
expp->nd_type = left->nd_def->df_type;
@ -1238,9 +1234,16 @@ ChkStandard(expp)
arg->nd_right = 0;
FreeNode(arg);
arg = expp;
if (!(left = getarg(&arg, T_INTORCARD, 0, edf))) return 0;
MkCoercion(&(arg->nd_left), expp->nd_type);
free_it = 1;
/* fall through */
case S_CHR:
if (! getarg(&arg, T_CARDINAL, 0, edf)) return 0;
if (edf->df_value.df_stdname == S_CHR) {
expp->nd_type = char_type;
}
if (expp->nd_type != int_type) {
MkCoercion(&(arg->nd_left), expp->nd_type);
free_it = 1;
}
break;
case S_ADR:
@ -1344,10 +1347,16 @@ ChkCast(expp)
df);
}
expp->nd_right->nd_left = 0;
FreeLR(expp);
if (arg->nd_class == Value) {
expp->nd_right->nd_left = 0;
FreeLR(expp);
*expp = *arg;
free_node(arg);
}
else {
expp->nd_symb = CAST;
expp->nd_class = Uoper;
expp->nd_right = arg;
}
expp->nd_type = lefttype;

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

@ -319,15 +319,6 @@ CodeCall(nd)
return;
}
if (IsCast(left)) {
/* it was just a cast. Simply ignore it
*/
CodePExpr(right->nd_left);
*nd = *(right->nd_left);
nd->nd_type = left->nd_def->df_type;
return;
}
assert(IsProcCall(left));
if (right) {
@ -501,6 +492,11 @@ CodeStd(nd)
}
switch(std) {
case S_ORD:
case S_VAL:
CodePExpr(left);
break;
case S_ABS:
CodePExpr(left);
if (tp->tp_fund == T_INTEGER) {
@ -517,8 +513,7 @@ CodeStd(nd)
case S_CAP:
CodePExpr(left);
c_loc(0137); /* ASCII assumed */
C_and(word_size);
C_cal("cap");
break;
case S_HIGH:
@ -706,15 +701,17 @@ CodeOper(expr, true_label, false_label)
case T_REAL:
C_sbf(tp->tp_size);
break;
case T_CARDINAL:
if (rightop->nd_type == address_type) {
C_sbs(pointer_size);
break;
}
/* fall through */
case T_POINTER:
case T_EQUAL:
if (rightop->nd_type == address_type) {
C_sbs(tp->tp_size);
break;
}
C_ngi(rightop->nd_type->tp_size);
C_ads(rightop->nd_type->tp_size);
break;
case T_INTORCARD:
case T_CARDINAL:
subu(tp->tp_size);
break;
case T_SET:
@ -994,6 +991,8 @@ CodeUoper(nd)
CodeCoercion(nd->nd_right->nd_type, tp);
RangeCheck(tp, nd->nd_right->nd_type);
break;
case CAST:
break;
default:
crash("Bad unary operator");
}

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

@ -86,6 +86,7 @@ struct tokenname tkidf[] = { /* names of the identifier tokens */
struct tokenname tkinternal[] = { /* internal keywords */
{PROGRAM, ""},
{COERCION, ""},
{CAST, ""},
{0, "0"}
};

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

@ -95,6 +95,7 @@ struct type {
#define T_ARRAY 0x2000
#define T_STRING 0x4000
#define T_INTORCARD (T_INTEGER|T_CARDINAL)
#define T_NOSUB (T_INTORCARD|T_ENUMERATION|T_CHAR)
#define T_NUMERIC (T_INTORCARD|T_REAL)
#define T_INDEX (T_ENUMERATION|T_CHAR|T_SUBRANGE)
#define T_DISCRETE (T_INDEX|T_INTORCARD)