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

Cleaned up a bit more

Browse source
This commit is contained in:
ceriel 1991-03-13 17:26:07 +00:00
parent f48f0efe60
commit f7504dbd4b
4 changed files with 78 additions and 90 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -52,15 +52,6 @@ df_error(nd, mess, edf)
else node_error(nd, mess);
}
STATIC int
ex_error(nd, mess)
register t_node *nd;
char *mess;
{
node_error(nd, "\"%s\": %s", symbol2str(nd->nd_symb), mess);
return 0;
}
MkCoercion(pnd, tp)
t_node **pnd;
register t_type *tp;
@ -203,7 +194,8 @@ ChkArrow(expp)
tp = exp->nd_RIGHT->nd_type;
if (tp->tp_fund != T_POINTER) {
return ex_error(exp, "illegal operand type");
node_error(exp, "\"^\": illegal operand type");
return 0;
}
if ((tp = RemoveEqual(PointedtoType(tp))) == 0) tp = error_type;
@ -910,6 +902,7 @@ ChkBinOper(expp)
t_type *result_type;
int allowed;
int retval;
char *symb;
/* First, check BOTH operands */
@ -941,7 +934,8 @@ ChkBinOper(expp)
*/
if (exp->nd_symb == IN) {
if (tpr->tp_fund != T_SET) {
return ex_error(exp, "right operand must be a set");
node_error(exp, "\"IN\": right operand must be a set");
return 0;
}
if (!TstAssCompat(ElementType(tpr), tpl)) {
/* Assignment compatible ???
@ -964,26 +958,27 @@ ChkBinOper(expp)
allowed = AllowedTypes(exp->nd_symb);
symb = symbol2str(exp->nd_symb);
if (!(tpr->tp_fund & allowed) || !(tpl->tp_fund & allowed)) {
if (!((T_CARDINAL & allowed) &&
ChkAddressOper(tpl, tpr, exp))) {
return ex_error(exp, "illegal operand type(s)");
node_error(exp, "\"%s\": illegal operand type(s)", symb);
return 0;
}
if (result_type == bool_type) exp->nd_type = bool_type;
}
else {
if (Boolean(exp->nd_symb) && tpl != bool_type) {
return ex_error(exp, "illegal operand type(s)");
node_error(exp, "\"%s\": illegal operand type(s)", symb);
return 0;
}
/* Operands must be compatible (distilled from Def 8.2)
*/
if (!TstCompat(tpr, tpl)) {
extern char *incompat();
char buf[128];
sprint(buf, "%s in operand(s)", incompat(tpl, tpr));
return ex_error(exp, buf);
node_error(exp, "\"%s\": %s in operands", symb, incompat(tpl, tpr));
return 0;
}
MkCoercion(&(exp->nd_LEFT), tpl);
@ -1080,7 +1075,8 @@ ChkUnOper(expp)
default:
crash("ChkUnOper");
}
return ex_error(exp, "illegal operand type");
node_error(exp, "\"%s\": illegal operand type", symbol2str(exp->nd_symb));
return 0;
}
STATIC t_node *

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

@ -185,7 +185,7 @@ CodeCoercion(t1, t2)
case T_ENUMERATION:
case T_CARDINAL:
case T_INTORCARD:
if (sz1 < word_size) sz1 = word_size;
if ((int) sz1 < (int) word_size) sz1 = word_size;
/* fall through */
case T_EQUAL:
case T_POINTER:
@ -208,7 +208,7 @@ CodeCoercion(t1, t2)
switch(fund1) {
case T_INTEGER:
if (sz1 < word_size) {
if ((int) sz1 < (int) word_size) {
c_loc((int)sz1);
c_loc((int) word_size);
C_cii();
@ -220,7 +220,7 @@ CodeCoercion(t1, t2)
C_cif();
break;
}
if (sz2 != sz1) {
if ((int) sz2 != (int) sz1) {
c_loc((int)sz1);
c_loc((int)sz2);
switch(fund2) {
@ -244,7 +244,7 @@ CodeCoercion(t1, t2)
C_cuf();
break;
}
if (sz1 != sz2) {
if ((int) sz1 != (int) sz2) {
c_loc((int)sz1);
c_loc((int)sz2);
switch(fund2) {
@ -264,7 +264,7 @@ CodeCoercion(t1, t2)
case T_REAL:
switch(fund2) {
case T_REAL:
if (sz1 != sz2) {
if ((int) sz1 != (int) sz2) {
c_loc((int)sz1);
c_loc((int)sz2);
C_cff();
@ -404,7 +404,7 @@ CodeParameters(param, arg)
}
}
else if (arg->nd_symb == STRING) {
C_loc((arith)(arg->nd_SLE - 1));
c_loc((int) arg->nd_SLE - 1);
}
else if (elem == word_type) {
C_loc((arg_type->tp_size+word_size-1) / word_size - 1);
@ -464,22 +464,22 @@ CodePString(nd, tp)
static
subu(sz)
arith sz;
int sz;
{
if (! options['R']) {
C_cal((int) sz == (int) word_size ? "subuchk" : "subulchk");
C_cal(sz == (int) word_size ? "subuchk" : "subulchk");
}
C_sbu(sz);
C_sbu((arith) sz);
}
static
addu(sz)
arith sz;
int sz;
{
if (! options['R']) {
C_cal((int) sz == (int) word_size ? "adduchk" : "addulchk");
C_cal(sz == (int) word_size ? "adduchk" : "addulchk");
}
C_adu(sz);
C_adu((arith)sz);
}
CodeStd(nd)
@ -555,7 +555,7 @@ CodeStd(nd)
register arith size;
size = left->nd_type->tp_size;
if (size < word_size) size = word_size;
if ((int) size < (int) word_size) size = word_size;
CodePExpr(left);
CodeCoercion(left->nd_type, tp);
if (arg) {
@ -568,13 +568,13 @@ CodeStd(nd)
}
if (std == S_DEC) {
if (tp->tp_fund == T_INTEGER) C_sbi(size);
else subu(size);
else subu((int) size);
}
else {
if (tp->tp_fund == T_INTEGER) C_adi(size);
else addu(size);
else addu((int) size);
}
if (size == word_size) {
if ((int) size == (int) word_size) {
RangeCheck(left->nd_type, tp->tp_fund == T_INTEGER ?
int_type : card_type);
}
@ -684,7 +684,7 @@ CodeOper(expr, true_label, false_label)
break;
case T_CARDINAL:
case T_INTORCARD:
addu(tp->tp_size);
addu((int) tp->tp_size);
break;
case T_SET:
C_ior(tp->tp_size);
@ -713,7 +713,7 @@ CodeOper(expr, true_label, false_label)
break;
case T_INTORCARD:
case T_CARDINAL:
subu(tp->tp_size);
subu((int) tp->tp_size);
break;
case T_SET:
C_com(tp->tp_size);
@ -767,11 +767,9 @@ CodeOper(expr, true_label, false_label)
Operands(expr);
switch(tp->tp_fund) {
case T_INTEGER:
if ((int)(tp->tp_size) == word_size) {
C_cal((int)(tp->tp_size) == (int)word_size
? "dvi"
: "dvil");
}
C_asp(2*tp->tp_size);
C_lfr(tp->tp_size);
break;
@ -789,11 +787,9 @@ CodeOper(expr, true_label, false_label)
Operands(expr);
switch(tp->tp_fund) {
case T_INTEGER:
if ((int)(tp->tp_size) == word_size) {
C_cal((int)(tp->tp_size) == (int)word_size
? "rmi"
: "rmil");
}
C_asp(2*tp->tp_size);
C_lfr(tp->tp_size);
break;

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

@ -30,13 +30,17 @@ extern char *symbol2str();
#define arith_sign ((arith) (1L << (sizeof(arith) * 8 - 1)))
#ifndef NOCROSS
arith full_mask[MAXSIZE];/* full_mask[1] == 0xFF, full_mask[2] == 0xFFFF, .. */
arith max_int[MAXSIZE]; /* max_int[1] == 0x7F, max_int[2] == 0x7FFF, .. */
arith min_int[MAXSIZE]; /* min_int[1] == 0xFFFFFF80, min_int[2] = 0xFFFF8000,
...
*/
#ifndef NOCROSS
unsigned int wrd_bits; /* number of bits in a word */
#else
arith full_mask[4] = { 0L, 0xFFL, 0xFFFFL, 0L, 0xFFFFFFFFL };
arith max_int[4] = { 0L, 0x7FL, 0x7FFFL, 0L, 0x7FFFFFFFL };
arith min_int[4] = { 0L, -128L, -32768L, 0L, -2147483647L-1 };
#endif
extern char options[];
@ -49,14 +53,6 @@ overflow(expp)
}
}
underflow(expp)
t_node *expp;
{
if (expp->nd_type != address_type) {
node_warning(expp, W_ORDINARY, "underflow in constant expression");
}
}
STATIC
commonbin(expp)
t_node **expp;
@ -182,18 +178,20 @@ cstibin(expp)
switch (exp->nd_symb) {
case '*':
if (o1 > 0 && o2 > 0) {
if (max_int[sz] / o1 < o2) overflow(exp);
if (o1 > 0) {
if (o2 > 0) {
if (max_int[sz] / o1 < o2) overflow(exp);
}
else if (min_int[sz] / o1 > o2) overflow(exp);
}
else if (o1 < 0 && o2 < 0) {
if (o1 == min_int[sz] || o2 == min_int[sz] ||
max_int[sz] / (-o1) < (-o2)) overflow(exp);
}
else if (o1 > 0) {
if (min_int[sz] / o1 > o2) overflow(exp);
}
else if (o2 > 0) {
if (min_int[sz] / o2 > o1) overflow(exp);
else if (o1 < 0) {
if (o2 < 0) {
if (o1 == min_int[sz] || o2 == min_int[sz] ||
max_int[sz] / (-o1) < (-o2)) overflow(exp);
}
else if (o2 > 0) {
if (min_int[sz] / o2 > o1) overflow(exp);
}
}
o1 *= o2;
break;
@ -219,22 +217,16 @@ cstibin(expp)
break;
case '+':
if (o1 > 0 && o2 > 0) {
if (max_int[sz] - o1 < o2) overflow(exp);
}
else if (o1 < 0 && o2 < 0) {
if (min_int[sz] - o1 > o2) overflow(exp);
}
if ( (o1 > 0 && o2 > 0 && max_int[sz] - o1 < o2)
|| (o1 < 0 && o2 < 0 && min_int[sz] - o1 > o2)
) overflow(exp);
o1 += o2;
break;
case '-':
if (o1 >= 0 && o2 < 0) {
if (max_int[sz] + o2 < o1) overflow(exp);
}
else if (o1 < 0 && o2 >= 0) {
if (min_int[sz] + o2 > o1) overflow(exp);
}
if ( (o1 >= 0 && o2 < 0 && max_int[sz] + o2 < o1)
|| (o1 < 0 && o2 >= 0 && min_int[sz] + o2 > o1)
) overflow(exp);
o1 -= o2;
break;
@ -390,20 +382,15 @@ cstubin(expp)
break;
case DIV:
if (o2 == 0) {
node_error(exp, "division by 0");
return;
}
divide(&o1, &o2);
break;
case MOD:
if (o2 == 0) {
node_error(exp, "modulo by 0");
node_error(exp, exp->nd_symb == DIV ?
"division by 0" :
"modulo by 0");
return;
}
divide(&o1, &o2);
o1 = o2;
if (exp->nd_symb == MOD) o1 = o2;
break;
case '+':
@ -414,14 +401,14 @@ cstubin(expp)
break;
case '-':
if (! chk_bounds(o2, o1, T_CARDINAL)) {
if (exp->nd_type->tp_fund == T_INTORCARD) {
exp->nd_type = int_type;
if (! chk_bounds(min_int[sz], o1 - o2, T_CARDINAL)) {
underflow(exp);
}
}
else underflow(exp);
if ( exp->nd_type != address_type
&& !chk_bounds(o2, o1, T_CARDINAL)
&& ( exp->nd_type->tp_fund != T_INTORCARD
|| ( exp->nd_type = int_type
, !chk_bounds(min_int[sz], o1 - o2, T_CARDINAL) ) )
) {
node_warning(exp, W_ORDINARY,
"underflow in constant expression");
}
o1 -= o2;
break;
@ -683,6 +670,7 @@ CutSize(expr)
InitCst()
{
register int i = 0;
#ifndef NOCROSS
register arith bt = (arith)0;
while (!(bt < 0)) {
@ -699,7 +687,10 @@ InitCst()
fatal("sizeof (arith) insufficient on this machine");
}
#ifndef NOCROSS
wrd_bits = 8 * (int) word_size;
#else
if (options['s']) {
for (i = 0; i < sizeof(long); i++) min_int[i] = - max_int[i];
}
#endif
}

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

@ -27,6 +27,7 @@
#include "walk.h"
#include "chk_expr.h"
#include "warning.h"
#include "uns_arith.h"
#ifndef NOCROSS
#include "target_sizes.h"
@ -302,10 +303,14 @@ chk_bounds(l1, l2, fund)
if (fund == T_INTEGER) {
return l2 >= l1;
}
#ifdef UNSIGNED_ARITH
return (UNSIGNED_ARITH) l2 >= (UNSIGNED_ARITH) l1;
#else
return (l2 & arith_sign ?
(l1 & arith_sign ? l2 >= l1 : 1) :
(l1 & arith_sign ? 0 : l2 >= l1)
);
#endif
}
int