if (edf->df_kind != D_ERROR) {
node_error(nd,"\"%s\": %s", edf->df_idf->id_text, mess);
}
+ return;
}
- else node_error(nd, "%s", mess);
+ node_error(nd, "%s", mess);
}
int
}
STATIC int
-ChkElement(expp, tp, set, level)
+ChkEl(expr, tp)
+ register struct node *expr;
+ struct type *tp;
+{
+ if (!ChkExpression(expr)) return 0;
+
+ if (!TstCompat(tp, expr->nd_type)) {
+ node_error(expr, "set element has incompatible type");
+ return 0;
+ }
+
+ return 1;
+}
+
+STATIC int
+ChkElement(expp, tp, set)
struct node **expp;
- register struct type *tp;
+ struct type *tp;
arith **set;
{
/* Check elements of a set. This routine may call itself
register struct node *expr = *expp;
register struct node *left = expr->nd_left;
register struct node *right = expr->nd_right;
- register arith i;
+ register unsigned int i;
+ arith lo, hi, low, high;
if (expr->nd_class == Link && expr->nd_symb == UPTO) {
/* { ... , expr1 .. expr2, ... }
First check expr1 and expr2, and try to compute them.
*/
- if (!ChkElement(&(expr->nd_left), tp, set, 1) ||
- !ChkElement(&(expr->nd_right), tp, set, 1)) {
+ if (! (ChkEl(left, tp) & ChkEl(right, tp))) {
return 0;
}
- if (left->nd_class == Value && right->nd_class == Value) {
- /* We have a constant range. Put all elements in the
- set
- */
-
- if (left->nd_INT > right->nd_INT) {
-node_error(expr, "lower bound exceeds upper bound in range");
- return 0;
- }
-
- for (i=left->nd_INT; i<=right->nd_INT; i++) {
- (*set)[i/wrd_bits] |= (1<<(i%wrd_bits));
- }
- FreeNode(expr);
- *expp = 0;
+ if (!(left->nd_class == Value && right->nd_class == Value)) {
+ return 1;
}
+ /* We have a constant range. Put all elements in the
+ set
+ */
- return 1;
+ low = left->nd_INT;
+ high = right->nd_INT;
}
-
- /* Here, a single element is checked
- */
- if (!ChkExpression(expr)) return 0;
-
- if (!TstCompat(tp, expr->nd_type)) {
- node_error(expr, "set element has incompatible type");
+ else {
+ if (! ChkEl(expr, tp)) return 0;
+ if (expr->nd_class != Value) {
+ return 1;
+ }
+ low = high = expr->nd_INT;
+ }
+ if (low > high) {
+ node_error(expr, "lower bound exceeds upper bound in range");
return 0;
}
- if (expr->nd_class == Value) {
- /* a constant element
- */
- arith low, high;
-
- i = expr->nd_INT;
- getbounds(tp, &low, &high);
-
- if (i < low || i > high) {
- node_error(expr, "set element out of range");
- return 0;
- }
-
- if (! level) {
- (*set)[i/wrd_bits] |= (1 << (i%wrd_bits));
- FreeNode(expr);
- *expp = 0;
- }
+ getbounds(tp, &lo, &hi);
+ if (low < lo || high > hi) {
+ node_error(expr, "set element out of range");
+ return 0;
}
+ for (i=(unsigned)low; i<= (unsigned)high; i++) {
+ (*set)[i/wrd_bits] |= (1<<(i%wrd_bits));
+ }
+ FreeNode(expr);
+ *expp = 0;
return 1;
}
assert(nd->nd_class == Link && nd->nd_symb == ',');
if (!ChkElement(&(nd->nd_left), ElementType(tp),
- &(expp->nd_set), 0)) {
+ &(expp->nd_set))) {
retval = 0;
}
if (nd->nd_left) expp->nd_class = Xset;
is no problem as such values take a word on the EM stack
anyway.
*/
+ register struct type *lefttype = left->nd_type;
register struct node *arg = expp->nd_right;
if ((! arg) || arg->nd_right) {
arg = arg->nd_left;
if (! ChkExpression(arg)) return 0;
- if (arg->nd_type->tp_size != left->nd_type->tp_size &&
+ if (arg->nd_type->tp_size != lefttype->tp_size &&
(arg->nd_type->tp_size > word_size ||
- left->nd_type->tp_size > word_size)) {
+ lefttype->tp_size > word_size)) {
Xerror(expp, "unequal sizes in type cast", left->nd_def);
}
if (arg->nd_class == Value) {
- struct type *tp = left->nd_type;
-
FreeNode(left);
expp->nd_right->nd_left = 0;
FreeNode(expp->nd_right);
expp->nd_left = expp->nd_right = 0;
*expp = *arg;
- expp->nd_type = tp;
+ expp->nd_type = lefttype;
}
- else expp->nd_type = left->nd_type;
+ else expp->nd_type = lefttype;
return 1;
}
int fp_used;
CodeConst(cst, size)
- arith cst, size;
+ arith cst;
+ int size;
{
/* Generate code to push constant "cst" with size "size"
*/
- if (size <= word_size) {
+ if (size <= (int) word_size) {
C_loc(cst);
}
- else if (size == dword_size) {
+ else if (size == (int) dword_size) {
C_ldc(cst);
}
else {
crash("(CodeConst)");
/*
C_df_dlb(++data_label);
- C_rom_icon(long2str((long) cst), size);
+ C_rom_icon(long2str((long) cst), (arith) size);
C_lae_dlb(data_label, (arith) 0);
- C_loi(size);
+ C_loi((arith) size);
*/
}
}
if (nd->nd_type->tp_fund != T_STRING) {
/* Character constant */
C_loc(nd->nd_INT);
+ return;
}
- else {
- C_df_dlb(++data_label);
- C_rom_scon(nd->nd_STR, WA(nd->nd_SLE + 1));
- C_lae_dlb(data_label, (arith) 0);
- }
+ C_df_dlb(++data_label);
+ C_rom_scon(nd->nd_STR, WA(nd->nd_SLE + 1));
+ C_lae_dlb(data_label, (arith) 0);
}
CodeExpr(nd, ds, true_label, false_label)
switch(nd->nd_symb) {
case REAL:
C_df_dlb(++data_label);
- C_rom_fcon(nd->nd_REL, nd->nd_type->tp_size);
+ C_rom_fcon(nd->nd_REL, tp->tp_size);
C_lae_dlb(data_label, (arith) 0);
- C_loi(nd->nd_type->tp_size);
+ C_loi(tp->tp_size);
break;
case STRING:
CodeString(nd);
break;
case INTEGER:
- CodeConst(nd->nd_INT, tp->tp_size);
+ CodeConst(nd->nd_INT, (int) (tp->tp_size));
break;
default:
crash("Value error");
case Xset:
case Set: {
- register int i = tp->tp_size / word_size;
+ register unsigned i = (unsigned) (tp->tp_size) / (int) word_size;
register arith *st = nd->nd_set + i;
ds->dsg_kind = DSG_LOADED;
- for (; i > 0; i--) {
+ for (; i; i--) {
C_loc(*--st);
}
CodeSet(nd);
and result is already done.
*/
register struct node *left = nd->nd_left;
+ register struct def *df;
register struct node *right = nd->nd_right;
register struct type *result_tp;
switch(left->nd_class) {
case Def: {
- register struct def *df = left->nd_def;
+ df = left->nd_def;
if (df->df_kind == D_PROCEDURE) {
int level = df->df_scope->sc_level;
CodePExpr(left);
break;
- case S_TRUNCD:
- case S_TRUNC:
case S_FLOAT:
+ CodePExpr(left);
+ RangeCheck(card_type, left->nd_type);
+ CodeCoercion(tp, nd->nd_type);
+ break;
+
+ case S_TRUNC: {
+ label lb = ++text_label;
+
+ CodePExpr(left);
+ C_dup(tp->tp_size);
+ C_zrf(tp->tp_size);
+ C_cmf(tp->tp_size);
+ C_zge(lb);
+ C_loc((arith) ECONV);
+ C_trp();
+ C_df_ilb(lb);
+ CodeCoercion(tp, nd->nd_type);
+ }
+ break;
+
+ case S_TRUNCD:
case S_FLOATD:
case S_LONG:
case S_SHORT:
if (true_label != NO_LABEL) {
compare(expr->nd_symb, true_label);
C_bra(false_label);
+ break;
}
- else {
- truthvalue(expr->nd_symb);
- }
+ truthvalue(expr->nd_symb);
break;
+
case IN:
/* In this case, evaluate right hand side first! The
INN instruction expects the bit number on top of the
extern arith
max_int, /* maximum integer on target machine */
max_unsigned, /* maximum unsigned on target machine */
- max_longint, /* maximum longint on target machine */
+ max_longint; /* maximum longint on target machine */
+extern unsigned int
wrd_bits; /* Number of bits in a word */
arith max_int; /* maximum integer on target machine */
arith max_unsigned; /* maximum unsigned on target machine */
arith max_longint; /* maximum longint on target machine */
-arith wrd_bits; /* number of bits in a word */
+unsigned int wrd_bits; /* number of bits in a word */
extern char options[];
/* The unary operation in "expp" is performed on the constant
expression below it, and the result restored in expp.
*/
- register arith o1 = expp->nd_right->nd_INT;
+ register struct node *right = expp->nd_right;
switch(expp->nd_symb) {
/* Should not get here
*/
case '-':
- o1 = -o1;
+ expp->nd_INT = -right->nd_INT;
if (expp->nd_type->tp_fund == T_INTORCARD) {
expp->nd_type = int_type;
}
case NOT:
case '~':
- o1 = !o1;
+ expp->nd_INT = !right->nd_INT;
break;
default:
}
expp->nd_class = Value;
- expp->nd_token = expp->nd_right->nd_token;
- expp->nd_INT = o1;
+ expp->nd_symb = right->nd_symb;
CutSize(expp);
- FreeNode(expp->nd_right);
+ FreeNode(right);
expp->nd_right = 0;
}
{
register arith *set1, *set2;
arith *resultset = 0;
- register int setsize, j;
+ register unsigned int setsize;
+ register int j;
assert(expp->nd_right->nd_class == Set);
assert(expp->nd_symb == IN || expp->nd_left->nd_class == Set);
set2 = expp->nd_right->nd_set;
- setsize = expp->nd_right->nd_type->tp_size / word_size;
+ setsize = (unsigned) expp->nd_right->nd_type->tp_size / (unsigned) word_size;
if (expp->nd_symb == IN) {
- arith i;
+ unsigned i;
assert(expp->nd_left->nd_class == Value);
i = expp->nd_left->nd_INT;
expp->nd_class = Value;
- expp->nd_INT = (i >= 0 && i < setsize * wrd_bits &&
+ expp->nd_INT = (expp->nd_left->nd_INT >= 0 &&
+ expp->nd_left->nd_INT < setsize * wrd_bits &&
(set2[i / wrd_bits] & (1 << (i % wrd_bits))));
free((char *) set2);
expp->nd_symb = INTEGER;
max_int = full_mask[int_size] & ~(1L << (int_size * 8 - 1));
max_unsigned = full_mask[int_size];
max_longint = full_mask[long_size] & ~(1L << (long_size * 8 - 1));
- wrd_bits = 8 * word_size;
+ wrd_bits = 8 * (unsigned) word_size;
}
extern int proclevel;
struct desig InitDesig = {DSG_INIT, 0, 0, 0};
-int C_ste_dnam(), C_sde_dnam(), C_loe_dnam(), C_lde_dnam();
-int C_stl(), C_sdl(), C_lol(), C_ldl();
-
-#define WRD 0
-#define DWRD 1
-#define LD 0
-#define STR 1
-
-static int (*lcl_ld_and_str[2][2])() = {
-{ C_lol, C_stl },
-{ C_ldl, C_sdl }
-};
-
-static int (*ext_ld_and_str[2][2])() = {
-{ C_loe_dnam, C_ste_dnam },
-{ C_lde_dnam, C_sde_dnam }
-};
-
int
-DoLoadOrStore(ds, size, LoadOrStoreFlag)
+WordOrDouble(ds, size)
register struct desig *ds;
arith size;
{
- int sz;
-
- if (ds->dsg_offset % word_size != 0) return 0;
+ return ((int) (ds->dsg_offset) % (int) word_size == 0 &&
+ ( (int) size == (int) word_size ||
+ (int) size == (int) dword_size));
+}
- if (size == word_size) sz = WRD;
- else if (size == dword_size) sz = DWRD;
- else return 0;
+int
+DoLoad(ds, size)
+ register struct desig *ds;
+ arith size;
+{
+ if (! WordOrDouble(ds, size)) return 0;
+ if (ds->dsg_name) {
+ if ((int) size == (int) word_size) {
+ C_loe_dnam(ds->dsg_name, ds->dsg_offset);
+ }
+ else C_lde_dnam(ds->dsg_name, ds->dsg_offset);
+ }
+ else {
+ if ((int) size == (int) word_size) {
+ C_lol(ds->dsg_offset);
+ }
+ else C_ldl(ds->dsg_offset);
+ }
+ return 1;
+}
+int
+DoStore(ds, size)
+ register struct desig *ds;
+ arith size;
+{
+ if (! WordOrDouble(ds, size)) return 0;
if (ds->dsg_name) {
- (*(ext_ld_and_str[sz][LoadOrStoreFlag]))(ds->dsg_name, ds->dsg_offset);
+ if ((int) size == (int) word_size) {
+ C_ste_dnam(ds->dsg_name, ds->dsg_offset);
+ }
+ else C_sde_dnam(ds->dsg_name, ds->dsg_offset);
}
else {
- (*(lcl_ld_and_str[sz][LoadOrStoreFlag]))(ds->dsg_offset);
+ if ((int) size == (int) word_size) {
+ C_stl(ds->dsg_offset);
+ }
+ else C_sdl(ds->dsg_offset);
}
return 1;
}
with DSG_FIXED.
*/
- arith szmodword = size % word_size; /* 0 if multiple of wordsize */
- arith wordmodsz = word_size % size; /* 0 if dividor of wordsize */
+ int szmodword = (int) size % (int) word_size; /* 0 if multiple of wordsize */
+ int wordmodsz = word_size % size; /* 0 if dividor of wordsize */
if (szmodword && wordmodsz) return 0;
if (al >= word_align) return 1;
if (szmodword && al >= szmodword) return 1;
return ds->dsg_kind == DSG_FIXED &&
- ((! szmodword && ds->dsg_offset % word_align == 0) ||
+ ((! szmodword && (int) (ds->dsg_offset) % word_align == 0) ||
(! wordmodsz && ds->dsg_offset % size == 0));
}
break;
case DSG_FIXED:
- if (DoLoadOrStore(ds, tp->tp_size, LD)) break;
+ if (DoLoad(ds, tp->tp_size)) break;
/* Fall through */
case DSG_PLOADED:
case DSG_PFIXED:
save = *ds;
switch(ds->dsg_kind) {
case DSG_FIXED:
- if (DoLoadOrStore(ds, tp->tp_size, STR)) break;
+ if (DoStore(ds, tp->tp_size)) break;
/* Fall through */
case DSG_PLOADED:
case DSG_PFIXED:
case DSG_PLOADED:
case DSG_PFIXED:
CodeAddress(rhs);
- if (tp->tp_size % word_size == 0 && tp->tp_align >= word_size) {
+ if ((int) (tp->tp_size) % (int) word_size == 0 &&
+ tp->tp_align >= (int) word_size) {
CodeDesig(left, lhs);
CodeAddress(lhs);
C_blm(tp->tp_size);
case DSG_FIXED:
CodeDesig(left, lhs);
if (lhs->dsg_kind == DSG_FIXED &&
- lhs->dsg_offset % word_size ==
- rhs->dsg_offset % word_size) {
+ (int) (lhs->dsg_offset) % (int) word_size ==
+ (int) (rhs->dsg_offset) % (int) word_size) {
register int sz;
arith size = tp->tp_size;
- while (size && (sz = (lhs->dsg_offset % word_size))) {
+ while (size &&
+ (sz = ((int)(lhs->dsg_offset) % (int)word_size))) {
/* First copy up to word-aligned
boundaries
*/
lhs->dsg_offset += sz;
size -= sz;
}
- else for (sz = dword_size; sz; sz -= word_size) {
+ else for (sz = (int) dword_size; sz; sz -= (int) word_size) {
while (size >= sz) {
/* Then copy dwords, words.
Depend on peephole optimizer
CodeAddress(lhs);
loadedflag = 1;
}
- if (tp->tp_size % word_size == 0 && tp->tp_align >= word_size) {
+ if ((int)(tp->tp_size) % (int) word_size == 0 &&
+ tp->tp_align >= word_size) {
CodeAddress(rhs);
if (loadedflag) C_exg(pointer_size);
else CodeAddress(lhs);
break;
case DSG_PFIXED:
- DoLoadOrStore(ds, word_size, LD);
+ DoLoad(ds, word_size);
break;
case DSG_INDEXED:
/* the programmer specified an address in the declaration of
the variable. Generate code to push the address.
*/
- CodeConst(df->var_off, pointer_size);
+ CodeConst(df->var_off, (int) pointer_size);
ds->dsg_kind = DSG_PLOADED;
ds->dsg_offset = 0;
return;
break;
case 'W':
- while (*text) {
- switch(*text++) {
- case 'O':
- warning_classes |= W_OLDFASHIONED;
- break;
- case 'R':
- warning_classes |= W_STRICT;
- break;
- case 'W':
- warning_classes |= W_ORDINARY;
- break;
+ if (*text) {
+ while (*text) {
+ switch(*text++) {
+ case 'O':
+ warning_classes |= W_OLDFASHIONED;
+ break;
+ case 'R':
+ warning_classes |= W_STRICT;
+ break;
+ case 'W':
+ warning_classes |= W_ORDINARY;
+ break;
+ }
}
}
+ else warning_classes = W_OLDFASHIONED|W_STRICT|W_ORDINARY;
break;
case 'M': { /* maximum identifier length */
getbounds(tp, &lb, &ub);
- if (lb < 0 || ub > maxset-1) {
+ if (lb < 0 || ub > maxset-1 || (sizeof(int)==2 && ub > 65535)) {
error("set type limits exceeded");
return error_type;
}
public / ack.git / commitdiff