From 746f94368da72a0d399ff78c08debe767fee4a31 Mon Sep 17 00:00:00 2001 From: ceriel Date: Tue, 23 Jun 1987 17:12:25 +0000 Subject: [PATCH] fixes, added 's' option --- lang/m2/comp/code.c | 64 ++++++++++++++++++++--------- lang/m2/comp/cstoper.c | 8 +++- lang/m2/comp/desig.c | 43 ++++++++++--------- lang/m2/comp/node.c | 2 +- lang/m2/comp/options.c | 1 + lang/m2/comp/walk.c | 93 ++++++++++++++---------------------------- 6 files changed, 107 insertions(+), 104 deletions(-) diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c index f2e846a36..ca90aa87b 100644 --- a/lang/m2/comp/code.c +++ b/lang/m2/comp/code.c @@ -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) diff --git a/lang/m2/comp/cstoper.c b/lang/m2/comp/cstoper.c index 22b453b37..27ccad906 100644 --- a/lang/m2/comp/cstoper.c +++ b/lang/m2/comp/cstoper.c @@ -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; diff --git a/lang/m2/comp/desig.c b/lang/m2/comp/desig.c index e9d37352c..fb0a9ba8b 100644 --- a/lang/m2/comp/desig.c +++ b/lang/m2/comp/desig.c @@ -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; diff --git a/lang/m2/comp/node.c b/lang/m2/comp/node.c index f0c49da5e..c2a624ec2 100644 --- a/lang/m2/comp/node.c +++ b/lang/m2/comp/node.c @@ -100,8 +100,8 @@ PrNode(nd, lvl) indnt(lvl); print("\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 diff --git a/lang/m2/comp/options.c b/lang/m2/comp/options.c index 57e710fca..22b3104cb 100644 --- a/lang/m2/comp/options.c +++ b/lang/m2/comp/options.c @@ -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; diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c index d186f2712..db1dd2147 100644 --- a/lang/m2/comp/walk.c +++ b/lang/m2/comp/walk.c @@ -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); -- 2.34.1