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

some more fixes

Browse source
This commit is contained in:
ceriel 1987-09-14 11:24:12 +00:00
parent 617f210cf8
commit 74c758e503
4 changed files with 60 additions and 26 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

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

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

@ -314,11 +314,23 @@ ChkExLinkOrName(expp)
assert(df->df_kind == D_CONST);
expp->nd_token = df->con_const;
expp->nd_lineno = ln;
if (expp->nd_class == Set) {
register int i =
(unsigned) expp->nd_type->tp_size /
(unsigned) word_size;
register arith *p, *q;
p = expp->nd_set;
q = (arith *) Malloc((unsigned) i * sizeof(arith));
expp->nd_set = q;
while (i--) *q++ = *p++;
}
}
}
if (!(df->df_kind & D_VALUE)) {
Xerror(expp, "value expected", df);
return 0;
}
if (df->df_kind == D_PROCEDURE) {
@ -663,7 +675,10 @@ ChkCall(expp)
variable.
*/
}
else node_error(left, "procedure, type, or function expected");
else {
node_error(left, "procedure, type, or function expected");
left->nd_type = error_type;
}
}
return ChkProcCall(expp);
}
@ -865,6 +880,12 @@ ChkUnOper(expp)
register struct node *right = expp->nd_right;
register struct type *tpr;
if (expp->nd_symb == '(') {
*expp = *right;
free_node(right);
return ChkExpression(expp);
}
expp->nd_type = error_type;
if (! ChkExpression(right)) return 0;
expp->nd_type = tpr = BaseType(right->nd_type);
MkCoercion(&(expp->nd_right), tpr);
@ -877,11 +898,6 @@ ChkUnOper(expp)
if (!(tpr->tp_fund & T_NUMERIC)) break;
/* fall through */
case '(':
*expp = *right;
free_node(right);
return 1;
case '-':
if (tpr->tp_fund & T_INTORCARD) {
if (tpr == intorcard_type || tpr == card_type) {
@ -894,13 +910,10 @@ ChkUnOper(expp)
}
else if (tpr->tp_fund == T_REAL) {
if (right->nd_class == Value) {
if (*(right->nd_REL) == '-') (right->nd_REL)++;
else (right->nd_REL)--;
expp->nd_class = Value;
expp->nd_symb = REAL;
expp->nd_REL = right->nd_REL;
*expp = *right;
if (*(expp->nd_REL) == '-') (expp->nd_REL)++;
else (expp->nd_REL)--;
FreeNode(right);
expp->nd_right = 0;
}
return 1;
}
@ -946,6 +959,7 @@ ChkStandard(expp)
struct node *arg = expp;
register struct node *left = expp->nd_left;
register struct def *edf = left->nd_def;
struct type *basetype;
int free_it = 0;
assert(left->nd_class == Def);
@ -954,13 +968,18 @@ ChkStandard(expp)
switch(edf->df_value.df_stdname) {
case S_ABS:
if (!(left = getarg(&arg, T_NUMERIC, 0, edf))) return 0;
MkCoercion(&(arg->nd_left), BaseType(left->nd_type));
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) {
free_it = 1;
}
break;
case S_CAP:

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

@ -154,6 +154,8 @@ CodeExpr(nd, ds, true_label, false_label)
for (; i; i--) {
C_loc(*--st);
}
free((char *) nd->nd_set);
nd->nd_set = 0;
CodeSet(nd);
}
break;

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

@ -486,7 +486,8 @@ WalkStat(nd, exit_label)
case FOR:
{
arith tmp = 0;
arith tmp = NewInt();
arith tmp2;
register struct node *fnd;
int good_forvar;
label l1 = ++text_label;
@ -506,10 +507,8 @@ WalkStat(nd, exit_label)
bstp = BaseType(nd->nd_type);
uns = bstp->tp_fund != T_INTEGER;
C_dup(int_size);
RangeCheck(left->nd_left->nd_type, nd->nd_type);
CodeDStore(nd);
CodePExpr(fnd);
tmp = NewInt();
C_stl(tmp);
C_lol(tmp);
if (uns) C_cmu(int_size);
@ -534,7 +533,18 @@ WalkStat(nd, exit_label)
nd->nd_def->df_flags |= D_FORLOOP;
C_df_ilb(l1);
}
if (! options['R']) {
tmp2 = NewInt();
ForLoopVarExpr(nd);
C_stl(tmp2);
}
WalkNode(right, exit_label);
if (! options['R']) {
C_lol(tmp2);
ForLoopVarExpr(nd);
C_cal("_forloopchk");
FreeInt(tmp2);
}
nd->nd_def->df_flags &= ~D_FORLOOP;
if (good_forvar && stepsize) {
C_lol(tmp);
@ -546,7 +556,7 @@ WalkStat(nd, exit_label)
C_loc(left->nd_INT);
ForLoopVarExpr(nd);
C_adu(int_size);
RangeCheck(bstp, nd->nd_type);
RangeCheck(nd->nd_type, bstp);
CodeDStore(nd);
}
C_bra(l1);
@ -736,7 +746,7 @@ DoForInit(nd)
tpl = left->nd_left->nd_type;
tpr = left->nd_right->nd_type;
if (!ChkAssCompat(&(left->nd_left), df->df_type, "FOR statement") ||
!ChkAssCompat(&(left->nd_right), df->df_type,"FOR statement")) {
!ChkAssCompat(&(left->nd_right), BaseType(df->df_type), "FOR statement")) {
return 1;
}
if (!TstCompat(df->df_type, tpl) ||
@ -788,6 +798,8 @@ RegisterMessages(df)
register struct def *df;
{
register struct type *tp;
arith sz;
int regtype = -1;
for (; df; df = df->df_nextinscope) {
if (df->df_kind == D_VARIABLE && !(df->df_flags & D_NOREG)) {
@ -796,15 +808,16 @@ RegisterMessages(df)
tp = BaseType(df->df_type);
if ((df->df_flags & D_VARPAR) ||
(tp->tp_fund & (T_POINTER|T_HIDDEN|T_EQUAL))) {
C_ms_reg(df->var_off, pointer_size,
reg_pointer, 0);
sz = pointer_size;
regtype = reg_pointer;
}
else if (tp->tp_fund & T_NUMERIC) {
C_ms_reg(df->var_off,
tp->tp_size,
tp->tp_fund == T_REAL ?
reg_float : reg_any,
0);
sz = tp->tp_size;
regtype = tp->tp_fund == T_REAL ?
reg_float : reg_any;
}
if (regtype >= 0) {
C_ms_reg(df->var_off, sz, regtype, 0);
}
}
}