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

fixes, added 's' option

Browse source
This commit is contained in:
ceriel 1987-06-23 17:12:25 +00:00
parent ef7fd61029
commit 746f94368d
6 changed files with 107 additions and 104 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -152,7 +152,7 @@ CodeExpr(nd, ds, true_label, false_label)
if (true_label != NO_LABEL) {
/* Only for boolean expressions
*/
CodeValue(ds, tp->tp_size, tp->tp_align);
CodeValue(ds, tp);
C_zne(true_label);
C_bra(false_label);
}
@ -162,14 +162,40 @@ CodeCoercion(t1, t2)
register struct type *t1, *t2;
{
register int fund1, fund2;
arith sz1 = t1->tp_size;
t1 = BaseType(t1);
t2 = BaseType(t2);
if (t1 == t2) return;
if ((fund1 = t1->tp_fund) == T_WORD) fund1 = T_INTEGER;
if ((fund2 = t2->tp_fund) == T_WORD) fund2 = T_INTEGER;
switch(fund1 = t1->tp_fund) {
case T_WORD:
fund1 = T_INTEGER;
break;
case T_CHAR:
case T_EQUAL:
case T_ENUMERATION:
case T_POINTER:
fund1 = T_CARDINAL;
break;
}
switch(fund2 = t1->tp_fund) {
case T_WORD:
fund2 = T_INTEGER;
break;
case T_CHAR:
case T_EQUAL:
case T_ENUMERATION:
case T_POINTER:
fund2 = T_CARDINAL;
break;
}
switch(fund1) {
case T_INTEGER:
if (sz1 < word_size) {
C_loc(sz1);
C_loc(word_size);
C_cii();
}
switch(fund2) {
case T_INTEGER:
if (t2->tp_size != t1->tp_size) {
@ -178,8 +204,6 @@ CodeCoercion(t1, t2)
C_cii();
}
break;
case T_ENUMERATION:
case T_CHAR:
case T_CARDINAL:
if (t1->tp_size != word_size) {
C_loc(t1->tp_size);
@ -197,16 +221,10 @@ CodeCoercion(t1, t2)
}
break;
case T_CHAR:
case T_ENUMERATION:
case T_CARDINAL:
case T_INTORCARD:
switch(fund2) {
case T_ENUMERATION:
case T_CHAR:
case T_CARDINAL:
case T_POINTER:
case T_EQUAL:
case T_INTORCARD:
if (t2->tp_size > word_size) {
C_loc(word_size);
@ -215,9 +233,11 @@ CodeCoercion(t1, t2)
}
break;
case T_INTEGER:
C_loc(word_size);
C_loc(t2->tp_size);
C_cui();
if (fund1 == T_CARDINAL || t2->tp_size != word_size) {
C_loc(word_size);
C_loc(t2->tp_size);
C_cui();
}
break;
case T_REAL:
C_loc(word_size);
@ -520,8 +540,14 @@ CodeStd(nd)
if (size < word_size) size = word_size;
CodePExpr(left);
if (arg) CodePExpr(arg->nd_left);
else C_loc((arith) 1);
if (arg) {
CodePExpr(arg->nd_left);
CodeCoercion(arg->nd_left->nd_type, tp);
}
else {
C_loc((arith) 1);
CodeCoercion(intorcard_type, tp);
}
if (std == S_DEC) {
if (tp->tp_fund == T_INTEGER) C_sbi(size);
else C_sbu(size);
@ -975,7 +1001,7 @@ CodePExpr(nd)
designator = InitDesig;
CodeExpr(nd, &designator, NO_LABEL, NO_LABEL);
CodeValue(&designator, nd->nd_type->tp_size, nd->nd_type->tp_align);
CodeValue(&designator, nd->nd_type);
}
CodeDAddress(nd)
@ -1003,7 +1029,7 @@ CodeDStore(nd)
designator = InitDesig;
CodeDesig(nd, &designator);
CodeStore(&designator, nd->nd_type->tp_size, nd->nd_type->tp_align);
CodeStore(&designator, nd->nd_type);
}
DoHIGH(df)

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

@ -32,6 +32,8 @@ 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 */
extern char options[];
static char ovflow[] = "overflow in constant expression";
cstunary(expp)
@ -423,10 +425,12 @@ cstcall(expp, call)
case S_MIN:
if (expp->nd_type == int_type) {
expp->nd_INT = (-max_int) - 1;
expp->nd_INT = -max_int;
if (! options['s']) expp->nd_INT--;
}
else if (expp->nd_type == longint_type) {
expp->nd_INT = (-max_longint) - 1;
expp->nd_INT = - max_longint;
if (! options['s']) expp->nd_INT--;
}
else if (expp->nd_type->tp_fund == T_SUBRANGE) {
expp->nd_INT = expp->nd_type->sub_lb;

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

@ -100,9 +100,9 @@ properly(ds, size, al)
(! wordmodsz && ds->dsg_offset % size == 0));
}
CodeValue(ds, size, al)
CodeValue(ds, tp)
register struct desig *ds;
arith size;
register struct type *tp;
{
/* Generate code to load the value of the designator described
in "ds"
@ -113,17 +113,17 @@ CodeValue(ds, size, al)
break;
case DSG_FIXED:
if (DoLoadOrStore(ds, size, LD)) break;
if (DoLoadOrStore(ds, tp->tp_size, LD)) break;
/* Fall through */
case DSG_PLOADED:
case DSG_PFIXED:
if (properly(ds, size, al)) {
if (properly(ds, tp->tp_size, tp->tp_align)) {
CodeAddress(ds);
C_loi(size);
C_loi(tp->tp_size);
break;
}
if (ds->dsg_kind == DSG_PLOADED) {
arith sz = WA(size) - pointer_size;
arith sz = WA(tp->tp_size) - pointer_size;
C_asp(-sz);
C_lor((arith) 1);
@ -131,10 +131,10 @@ CodeValue(ds, size, al)
C_loi(pointer_size);
}
else {
C_asp(-WA(size));
C_asp(-WA(tp->tp_size));
CodeAddress(ds);
}
C_loc(size);
C_loc(tp->tp_size);
C_cal("_load");
C_asp(2 * word_size);
break;
@ -148,11 +148,14 @@ CodeValue(ds, size, al)
}
ds->dsg_kind = DSG_LOADED;
if (tp->tp_fund == T_SUBRANGE) {
CodeCoercion(tp, BaseType(tp));
}
}
CodeStore(ds, size, al)
CodeStore(ds, tp)
register struct desig *ds;
arith size;
register struct type *tp;
{
/* Generate code to store the value on the stack in the designator
described in "ds"
@ -162,18 +165,18 @@ CodeStore(ds, size, al)
save = *ds;
switch(ds->dsg_kind) {
case DSG_FIXED:
if (DoLoadOrStore(ds, size, STR)) break;
if (DoLoadOrStore(ds, tp->tp_size, STR)) break;
/* Fall through */
case DSG_PLOADED:
case DSG_PFIXED:
CodeAddress(&save);
if (properly(ds, size, al)) {
C_sti(size);
if (properly(ds, tp->tp_size, tp->tp_align)) {
C_sti(tp->tp_size);
break;
}
C_loc(size);
C_loc(tp->tp_size);
C_cal("_store");
C_asp(2 * word_size + WA(size));
C_asp(2 * word_size + WA(tp->tp_size));
break;
case DSG_INDEXED:
@ -232,7 +235,7 @@ CodeMove(rhs, left, rtp)
C_asp(word_size << 2);
return;
}
CodeStore(lhs, tp->tp_size, tp->tp_align);
CodeStore(lhs, tp);
return;
case DSG_PLOADED:
case DSG_PFIXED:
@ -243,7 +246,7 @@ CodeMove(rhs, left, rtp)
C_blm(tp->tp_size);
return;
}
CodeValue(rhs, tp->tp_size, tp->tp_align);
CodeValue(rhs, tp);
CodeDStore(left);
return;
case DSG_FIXED:
@ -319,8 +322,8 @@ CodeMove(rhs, left, rtp)
lhs->dsg_def = 0;
C_stl(tmp); /* address of lhs */
}
CodeValue(rhs, tp->tp_size, tp->tp_align);
CodeStore(lhs, tp->tp_size, tp->tp_align);
CodeValue(rhs, tp);
CodeStore(lhs, tp);
if (loadedflag) FreePtr(tmp);
return;
}
@ -570,7 +573,7 @@ CodeDesig(nd, ds)
case DSG_INDEXED:
case DSG_PLOADED:
case DSG_PFIXED:
CodeValue(ds, pointer_size, pointer_align);
CodeValue(ds, nd->nd_right->nd_type);
ds->dsg_kind = DSG_PLOADED;
ds->dsg_offset = 0;
break;

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

@ -100,8 +100,8 @@ PrNode(nd, lvl)
indnt(lvl); print("<nilnode>\n");
return;
}
PrNode(nd->nd_left, lvl + 1);
printnode(nd, lvl);
PrNode(nd->nd_left, lvl + 1);
PrNode(nd->nd_right, lvl + 1);
}
#endif DEBUG

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

@ -43,6 +43,7 @@ DoOption(text)
case 'p': /* call procentry/procexit */
case 'n': /* no register messages */
case 'x': /* every name global */
case 's': /* symmetric: MIN(INTEGER) = -MAX(INTEGER) */
options[text[-1]]++;
break;

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

@ -231,8 +231,6 @@ WalkProcedure(procedure)
the stack adjusted, the return value pushed
again, and then RET
*/
arith tmpvar = NewInt();
if (! StackAdjustment) {
/* First time we get here
*/
@ -244,49 +242,22 @@ WalkProcedure(procedure)
sc->sc_off -= func_res_size;
retsav = sc->sc_off;
}
StackAdjustment = NewInt();
C_loc((arith) 0);
StackAdjustment = NewPtr();
C_lor((arith) 1);
C_stl(StackAdjustment);
}
/* First compute the size of the array */
C_lol(param->par_def->var_off +
pointer_size + word_size);
/* upper - lower */
C_inc(); /* gives number of elements */
C_loc(tp->arr_elem->tp_size);
C_mli(word_size);
C_loc(word_size - 1);
C_adi(word_size);
C_loc(word_size);
C_dvi(word_size);
/* size in words */
C_loc(word_size);
C_mli(word_size);
/* size in bytes */
C_stl(tmpvar);
C_lol(tmpvar);
C_lol(tmpvar);
C_lol(StackAdjustment);
C_adi(word_size);
C_stl(StackAdjustment);
/* remember stack adjustments */
C_ngi(word_size);
/* Assumption: stack grows
downwards!! ???
*/
C_ass(word_size);
/* First compute new stackpointer */
C_lal(param->par_def->var_off);
C_cal("_new_stackptr");
C_asp(pointer_size);
C_lfr(pointer_size);
C_str((arith) 1);
/* adjusted stack pointer */
C_lol(param->par_def->var_off);
/* push source address */
C_lol(tmpvar); /* push size */
C_cal("_load"); /* copy */
C_asp(2 * word_size);
C_lor((arith) 1);
/* push new address of array
... downwards ... ???
*/
C_stl(param->par_def->var_off);
FreeInt(tmpvar);
C_cal("_copy_array");
/* copy */
C_asp(word_size);
}
}
}
@ -307,37 +278,31 @@ WalkProcedure(procedure)
/* Remove copies of conformant arrays
*/
C_lol(StackAdjustment);
C_ass(word_size);
C_str((arith) 1);
}
C_lae_dlb(func_res_label, (arith) 0);
EndPriority();
C_ret(pointer_size);
}
else if (tp) {
if (StackAdjustment) {
/* First save the function result in a safe place.
Then remove copies of conformant arrays,
and put function result back on the stack
*/
else if (StackAdjustment) {
/* First save the function result in a safe place.
Then remove copies of conformant arrays,
and put function result back on the stack
*/
if (tp) {
C_lal(retsav);
C_sti(func_res_size);
C_lol(StackAdjustment);
C_ass(word_size);
}
C_lol(StackAdjustment);
C_str((arith) 1);
if (tp) {
C_lal(retsav);
C_loi(func_res_size);
}
EndPriority();
C_ret(func_res_size);
FreePtr(StackAdjustment);
}
else {
if (StackAdjustment) {
C_lol(StackAdjustment);
C_ass(word_size);
}
EndPriority();
C_ret((arith) 0);
}
if (StackAdjustment) FreeInt(StackAdjustment);
EndPriority();
C_ret(func_res_size);
if (! options['n']) RegisterMessages(sc->sc_def);
C_end(-sc->sc_off);
TmpClose();
@ -506,6 +471,10 @@ WalkStat(nd, exit_label)
label l2 = ++text_label;
good_forvar = DoForInit(nd, left);
#ifdef DEBUG
nd->nd_left = left;
nd->nd_right = right;
#endif
fnd = left->nd_right;
if (fnd->nd_class != Value) {
/* Upperbound not constant.
@ -561,7 +530,7 @@ WalkStat(nd, exit_label)
*/
ds.dsg_offset = NewPtr();
ds.dsg_name = 0;
CodeStore(&ds, pointer_size, pointer_align);
CodeStore(&ds, address_type);
ds.dsg_kind = DSG_PFIXED;
/* the record is indirectly available */
wds.w_desig = ds;
@ -759,7 +728,7 @@ DoAssign(nd, left, right)
if (StackNeededFor(&dsr)) CodeAddress(&dsr);
}
else {
CodeValue(&dsr, rtp->tp_size, rtp->tp_align);
CodeValue(&dsr, rtp);
CodeCheckExpr(rtp, ltp);
}
CodeMove(&dsr, left, rtp);