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

fixes and squeezing

Browse source
This commit is contained in:
ceriel 1987-12-02 10:41:38 +00:00
parent 9cc60526b7
commit a61d36ff49
6 changed files with 61 additions and 90 deletions

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

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

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

@ -1317,9 +1317,8 @@ ChkCast(expp)
} }
if (arg->nd_class == Value) { if (arg->nd_class == Value) {
FreeNode(expp->nd_left);
expp->nd_right->nd_left = 0; expp->nd_right->nd_left = 0;
FreeNode(expp->nd_right); FreeLR(expp);
*expp = *arg; *expp = *arg;
} }
expp->nd_type = lefttype; expp->nd_type = lefttype;

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

@ -867,7 +867,7 @@ CodeOper(expr, true_label, false_label)
CodePExpr(rightop); CodePExpr(rightop);
CodePExpr(leftop); CodePExpr(leftop);
C_loc(rightop->nd_type->set_low); C_loc(rightop->nd_type->set_low);
C_sbi(word_size); C_sbu(word_size);
C_inn(rightop->nd_type->tp_size); C_inn(rightop->nd_type->tp_size);
if (true_label != NO_LABEL) { if (true_label != NO_LABEL) {
C_zne(true_label); C_zne(true_label);

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

@ -40,13 +40,15 @@ overflow(expp)
{ {
node_warning(expp, W_ORDINARY, "overflow in constant expression"); node_warning(expp, W_ORDINARY, "overflow in constant expression");
} }
arith
ar_abs(i)
arith i;
{
return i < 0 ? -i : i; STATIC
commonbin(expp)
register t_node *expp;
{
expp->nd_class = Value;
expp->nd_token = expp->nd_right->nd_token;
CutSize(expp);
FreeLR(expp);
} }
cstunary(expp) cstunary(expp)
@ -56,6 +58,7 @@ cstunary(expp)
expression below it, and the result restored in expp. expression below it, and the result restored in expp.
*/ */
register t_node *right = expp->nd_right; register t_node *right = expp->nd_right;
arith o1;
switch(expp->nd_symb) { switch(expp->nd_symb) {
/* Should not get here /* Should not get here
@ -67,23 +70,20 @@ cstunary(expp)
if (right->nd_INT == min_int[(int)(right->nd_type->tp_size)]) if (right->nd_INT == min_int[(int)(right->nd_type->tp_size)])
overflow(expp); overflow(expp);
expp->nd_INT = -right->nd_INT; o1 = -right->nd_INT;
break; break;
case NOT: case NOT:
case '~': case '~':
expp->nd_INT = !right->nd_INT; o1 = !right->nd_INT;
break; break;
default: default:
crash("(cstunary)"); crash("(cstunary)");
} }
expp->nd_class = Value; commonbin(expp);
expp->nd_symb = right->nd_symb; expp->nd_INT = o1;
CutSize(expp);
FreeNode(right);
expp->nd_right = 0;
} }
STATIC STATIC
@ -153,19 +153,19 @@ cstibin(expp)
switch (expp->nd_symb) { switch (expp->nd_symb) {
case '*': case '*':
if (o1 == 0 || o2 == 0) { if (o1 > 0 && o2 > 0) {
o1 = 0; if (max_int[sz] / o1 < o2) overflow(expp);
break;
} }
if ((o1 > 0 && o2 > 0) || (o1 < 0 && o2 < 0)) { else if (o1 < 0 && o2 < 0) {
if (o1 == min_int[sz] || if (o1 == min_int[sz] || o2 == min_int[sz] ||
o2 == min_int[sz] || max_int[sz] / (-o1) < (-o2)) overflow(expp);
max_int[sz] / ar_abs(o1) < ar_abs(o2)) overflow(expp);
} }
else if (o1 > 0) { else if (o1 > 0) {
if (min_int[sz] / o1 > o2) overflow(expp); if (min_int[sz] / o1 > o2) overflow(expp);
} }
else if (min_int[sz] / o2 > o1) overflow(expp); else if (o2 > 0) {
if (min_int[sz] / o2 > o1) overflow(expp);
}
o1 *= o2; o1 *= o2;
break; break;
@ -206,27 +206,19 @@ cstibin(expp)
break; break;
case '<': case '<':
{ arith tmp = o1; o1 = (o1 < o2);
break;
o1 = o2;
o2 = tmp;
}
/* Fall through */
case '>': case '>':
o1 = (o1 > o2); o1 = (o1 > o2);
break; break;
case LESSEQUAL: case LESSEQUAL:
{ arith tmp = o1; o1 = (o2 <= o1);
break;
o1 = o2;
o2 = tmp;
}
/* Fall through */
case GREATEREQUAL: case GREATEREQUAL:
o1 = chk_bounds(o2, o1, T_INTEGER); o1 = (o2 >= o1);
break; break;
case '=': case '=':
@ -241,13 +233,8 @@ cstibin(expp)
crash("(cstibin)"); crash("(cstibin)");
} }
expp->nd_class = Value; commonbin(expp);
expp->nd_token = expp->nd_right->nd_token;
expp->nd_INT = o1; expp->nd_INT = o1;
CutSize(expp);
FreeNode(expp->nd_left);
FreeNode(expp->nd_right);
expp->nd_left = expp->nd_right = 0;
} }
cstubin(expp) cstubin(expp)
@ -317,24 +304,16 @@ cstubin(expp)
break; break;
case '<': case '<':
{ arith tmp = o1; o1 = ! chk_bounds(o2, o1, T_CARDINAL);
break;
o1 = o2;
o2 = tmp;
}
/* Fall through */
case '>': case '>':
o1 = ! chk_bounds(o1, o2, T_CARDINAL); o1 = ! chk_bounds(o1, o2, T_CARDINAL);
break; break;
case LESSEQUAL: case LESSEQUAL:
{ arith tmp = o1; o1 = chk_bounds(o1, o2, T_CARDINAL);
break;
o1 = o2;
o2 = tmp;
}
/* Fall through */
case GREATEREQUAL: case GREATEREQUAL:
o1 = chk_bounds(o2, o1, T_CARDINAL); o1 = chk_bounds(o2, o1, T_CARDINAL);
@ -361,14 +340,9 @@ cstubin(expp)
crash("(cstubin)"); crash("(cstubin)");
} }
expp->nd_class = Value; commonbin(expp);
expp->nd_token = expp->nd_right->nd_token;
if (expp->nd_type == bool_type) expp->nd_symb = INTEGER;
expp->nd_INT = o1; expp->nd_INT = o1;
CutSize(expp); if (expp->nd_type == bool_type) expp->nd_symb = INTEGER;
FreeNode(expp->nd_left);
FreeNode(expp->nd_right);
expp->nd_left = expp->nd_right = 0;
} }
cstset(expp) cstset(expp)
@ -399,9 +373,7 @@ cstset(expp)
(set2[i / wrd_bits] & (1 << (i % wrd_bits)))); (set2[i / wrd_bits] & (1 << (i % wrd_bits))));
FreeSet(set2); FreeSet(set2);
expp->nd_symb = INTEGER; expp->nd_symb = INTEGER;
FreeNode(expp->nd_left); FreeLR(expp);
FreeNode(expp->nd_right);
expp->nd_left = expp->nd_right = 0;
return; return;
} }
@ -469,9 +441,7 @@ cstset(expp)
} }
FreeSet(expp->nd_left->nd_set); FreeSet(expp->nd_left->nd_set);
FreeSet(expp->nd_right->nd_set); FreeSet(expp->nd_right->nd_set);
FreeNode(expp->nd_left); FreeLR(expp);
FreeNode(expp->nd_right);
expp->nd_left = expp->nd_right = 0;
} }
cstcall(expp, call) cstcall(expp, call)
@ -486,29 +456,26 @@ cstcall(expp, call)
assert(expp->nd_class == Call); assert(expp->nd_class == Call);
expr = expp->nd_right->nd_left; expr = expp->nd_right->nd_left;
expp->nd_right->nd_left = 0;
FreeNode(expp->nd_right);
tp = expr->nd_type; tp = expr->nd_type;
expp->nd_class = Value; expp->nd_class = Value;
expp->nd_symb = INTEGER; expp->nd_symb = INTEGER;
expp->nd_INT = expr->nd_INT;
switch(call) { switch(call) {
case S_ABS: case S_ABS:
if (expr->nd_INT < 0) { if (expp->nd_INT < 0) {
if (expr->nd_INT <= min_int[(int)(tp->tp_size)]) { if (expp->nd_INT <= min_int[(int)(tp->tp_size)]) {
overflow(expr); overflow(expr);
} }
expp->nd_INT = - expr->nd_INT; expp->nd_INT = - expp->nd_INT;
} }
else expp->nd_INT = expr->nd_INT;
CutSize(expp); CutSize(expp);
break; break;
case S_CAP: case S_CAP:
if (expr->nd_INT >= 'a' && expr->nd_INT <= 'z') { if (expp->nd_INT >= 'a' && expp->nd_INT <= 'z') {
expr->nd_INT = expr->nd_INT + ('A' - 'a'); expp->nd_INT += ('A' - 'a');
} }
expp->nd_INT = expr->nd_INT;
break; break;
case S_MAX: case S_MAX:
@ -535,7 +502,7 @@ cstcall(expp, call)
break; break;
case S_ODD: case S_ODD:
expp->nd_INT = (expr->nd_INT & 1); expp->nd_INT &= 1;
break; break;
case S_SIZE: case S_SIZE:
@ -545,9 +512,7 @@ cstcall(expp, call)
default: default:
crash("(cstcall)"); crash("(cstcall)");
} }
FreeNode(expr); FreeLR(expp);
FreeNode(expp->nd_left);
expp->nd_right = expp->nd_left = 0;
} }
CutSize(expr) CutSize(expr)
@ -565,8 +530,7 @@ CutSize(expr)
else { else {
int nbits = (int) (mach_long_size - tp->tp_size) * 8; int nbits = (int) (mach_long_size - tp->tp_size) * 8;
expr->nd_INT <<= nbits; expr->nd_INT = (expr->nd_INT << nbits) >> nbits;
expr->nd_INT >>= nbits;
} }
} }
@ -576,7 +540,8 @@ InitCst()
register arith bt = (arith)0; register arith bt = (arith)0;
while (!(bt < 0)) { while (!(bt < 0)) {
bt = (bt << 8) + 0377, i++; i++;
bt = (bt << 8) + 0377;
if (i == MAXSIZE) if (i == MAXSIZE)
fatal("array full_mask too small for this machine"); fatal("array full_mask too small for this machine");
full_mask[i] = bt; full_mask[i] = bt;
@ -590,5 +555,5 @@ InitCst()
fatal("sizeof (long) insufficient on this machine"); fatal("sizeof (long) insufficient on this machine");
} }
wrd_bits = 8 * (unsigned) word_size; wrd_bits = 8 * (int) word_size;
} }

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

@ -61,6 +61,14 @@ dot2leaf(class)
return MkLeaf(class, &dot); return MkLeaf(class, &dot);
} }
FreeLR(nd)
register t_node *nd;
{
FreeNode(nd->nd_left);
FreeNode(nd->nd_right);
nd->nd_left = nd->nd_right = 0;
}
FreeNode(nd) FreeNode(nd)
register t_node *nd; register t_node *nd;
{ {
@ -68,8 +76,7 @@ FreeNode(nd)
list list
*/ */
if (!nd) return; if (!nd) return;
FreeNode(nd->nd_left); FreeLR(nd);
FreeNode(nd->nd_right);
free_node(nd); free_node(nd);
} }

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

@ -471,7 +471,7 @@ set_type(tp)
*/ */
arith lb, ub, diff; arith lb, ub, diff;
if (! bounded(tp)) { if (! bounded(tp) || tp->tp_size > word_size) {
error("illegal base type for set"); error("illegal base type for set");
return error_type; return error_type;
} }
@ -485,7 +485,7 @@ set_type(tp)
#endif #endif
diff = ub - lb + 1; diff = ub - lb + 1;
if (diff < 0 || (sizeof(int) == 2 && diff > 65535)) { if (diff < 0) {
error("set type limits exceeded"); error("set type limits exceeded");
return error_type; return error_type;
} }