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

fixes, changes to make smaller on PDP

Browse source
This commit is contained in:
ceriel 1987-07-21 13:54:33 +00:00
parent 1c1eed4fd8
commit 6614384f3c
7 changed files with 180 additions and 141 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -45,8 +45,9 @@ Xerror(nd, mess, edf)
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
@ -277,9 +278,24 @@ node_error(expp, "standard or local procedures may not be assigned");
}
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
@ -289,66 +305,50 @@ ChkElement(expp, tp, set, level)
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) {
if (!(left->nd_class == Value && right->nd_class == Value)) {
return 1;
}
/* We have a constant range. Put all elements in the
set
*/
if (left->nd_INT > right->nd_INT) {
low = left->nd_INT;
high = right->nd_INT;
}
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;
}
for (i=left->nd_INT; i<=right->nd_INT; i++) {
(*set)[i/wrd_bits] |= (1<<(i%wrd_bits));
}
FreeNode(expr);
*expp = 0;
}
return 1;
}
/* 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");
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) {
getbounds(tp, &lo, &hi);
if (low < lo || high > hi) {
node_error(expr, "set element out of range");
return 0;
}
if (! level) {
for (i=(unsigned)low; i<= (unsigned)high; i++) {
(*set)[i/wrd_bits] |= (1<<(i%wrd_bits));
}
FreeNode(expr);
*expp = 0;
}
}
return 1;
}
@ -407,7 +407,7 @@ ChkSet(expp)
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;
@ -1172,6 +1172,7 @@ ChkCast(expp, left)
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) {
@ -1182,23 +1183,21 @@ ChkCast(expp, left)
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;
}

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

@ -36,24 +36,25 @@ extern int proclevel;
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);
*/
}
}
@ -64,13 +65,12 @@ CodeString(nd)
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);
}
}
CodeExpr(nd, ds, true_label, false_label)
register struct node *nd;
@ -111,15 +111,15 @@ 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");
@ -134,11 +134,11 @@ CodeExpr(nd, ds, true_label, false_label)
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);
@ -282,6 +282,7 @@ CodeCall(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;
@ -307,7 +308,7 @@ CodeCall(nd)
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;
@ -516,9 +517,28 @@ CodeStd(nd)
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:
@ -816,11 +836,11 @@ CodeOper(expr, true_label, false_label)
if (true_label != NO_LABEL) {
compare(expr->nd_symb, true_label);
C_bra(false_label);
}
else {
truthvalue(expr->nd_symb);
}
break;
}
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

3
lang/m2/comp/const.h
View file

@ -16,5 +16,6 @@ extern int
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 */

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

@ -30,7 +30,7 @@ long full_mask[MAXSIZE];/* full_mask[1] == 0xFF, full_mask[2] == 0xFFFF, .. */
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[];
@ -42,7 +42,7 @@ cstunary(expp)
/* 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
@ -51,7 +51,7 @@ cstunary(expp)
*/
case '-':
o1 = -o1;
expp->nd_INT = -right->nd_INT;
if (expp->nd_type->tp_fund == T_INTORCARD) {
expp->nd_type = int_type;
}
@ -59,7 +59,7 @@ cstunary(expp)
case NOT:
case '~':
o1 = !o1;
expp->nd_INT = !right->nd_INT;
break;
default:
@ -67,10 +67,9 @@ cstunary(expp)
}
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;
}
@ -247,21 +246,23 @@ cstset(expp)
{
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;
@ -531,5 +532,5 @@ InitCst()
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;
}

97
lang/m2/comp/desig.c
View file

@ -33,42 +33,54 @@
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;
if (size == word_size) sz = WRD;
else if (size == dword_size) sz = DWRD;
else return 0;
return ((int) (ds->dsg_offset) % (int) word_size == 0 &&
( (int) size == (int) word_size ||
(int) size == (int) dword_size));
}
int
DoLoad(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_loe_dnam(ds->dsg_name, ds->dsg_offset);
}
else C_lde_dnam(ds->dsg_name, ds->dsg_offset);
}
else {
(*(lcl_ld_and_str[sz][LoadOrStoreFlag]))(ds->dsg_offset);
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) {
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 {
if ((int) size == (int) word_size) {
C_stl(ds->dsg_offset);
}
else C_sdl(ds->dsg_offset);
}
return 1;
}
@ -88,15 +100,15 @@ properly(ds, size, al)
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));
}
@ -114,7 +126,7 @@ CodeValue(ds, tp)
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:
@ -167,7 +179,7 @@ CodeStore(ds, tp)
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:
@ -242,7 +254,8 @@ CodeMove(rhs, left, rtp)
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);
@ -254,12 +267,13 @@ CodeMove(rhs, left, rtp)
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
*/
@ -282,7 +296,7 @@ CodeMove(rhs, left, rtp)
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
@ -306,7 +320,8 @@ CodeMove(rhs, left, rtp)
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);
@ -359,7 +374,7 @@ CodeAddress(ds)
break;
case DSG_PFIXED:
DoLoadOrStore(ds, word_size, LD);
DoLoad(ds, word_size);
break;
case DSG_INDEXED:
@ -445,7 +460,7 @@ CodeVarDesig(df, ds)
/* 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;

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

@ -80,6 +80,7 @@ DoOption(text)
break;
case 'W':
if (*text) {
while (*text) {
switch(*text++) {
case 'O':
@ -93,6 +94,8 @@ DoOption(text)
break;
}
}
}
else warning_classes = W_OLDFASHIONED|W_STRICT|W_ORDINARY;
break;
case 'M': { /* maximum identifier length */

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

@ -452,7 +452,7 @@ set_type(tp)
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;
}