From: ceriel Date: Fri, 28 Nov 1986 11:59:08 +0000 (+0000) Subject: many bug fixes, and added flexibility in alignments X-Git-Tag: release-5-5~5137 X-Git-Url: https://git.ndcode.org/public/gitweb.cgi?a=commitdiff_plain;h=a0c21bf820902c70843729b6b4888f3309d88ae6;p=ack.git many bug fixes, and added flexibility in alignments --- diff --git a/lang/m2/comp/Version.c b/lang/m2/comp/Version.c index 521e211af..3eac69236 100644 --- a/lang/m2/comp/Version.c +++ b/lang/m2/comp/Version.c @@ -1 +1 @@ -char Version[] = "ACK Modula-2 compiler Version 0.8"; +static char Version[] = "ACK Modula-2 compiler Version 0.9"; diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c index 0e2b0ccc4..d97a51f2e 100644 --- a/lang/m2/comp/chk_expr.c +++ b/lang/m2/comp/chk_expr.c @@ -540,7 +540,7 @@ ChkProcCall(expp) if (left->nd_symb == STRING) { TryToString(left, TypeOfParam(param)); } - else if (! TstParCompat(RemoveEqual(TypeOfParam(param)), + if (! TstParCompat(RemoveEqual(TypeOfParam(param)), left->nd_type, IsVarParam(param), left)) { @@ -1017,10 +1017,14 @@ ChkStandard(expp, left) case S_TSIZE: /* ??? */ case S_SIZE: expp->nd_type = intorcard_type; - if (! getname(&arg, D_FIELD|D_VARIABLE|D_ISTYPE, 0, edf)) { + if (!(left = getname(&arg,D_FIELD|D_VARIABLE|D_ISTYPE,0,edf))) { return 0; } - cstcall(expp, S_SIZE); + if (! IsConformantArray(left->nd_type)) cstcall(expp, S_SIZE); + else node_warning(expp, + W_STRICT, + "%s on conformant array", + expp->nd_left->nd_def->df_idf->id_text); break; case S_TRUNC: diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c index a91f0c989..bbef689fa 100644 --- a/lang/m2/comp/code.c +++ b/lang/m2/comp/code.c @@ -65,27 +65,6 @@ CodeString(nd) } } -STATIC -CodePadString(nd, sz) - register struct node *nd; - arith sz; -{ - /* Generate code to push the string indicated by "nd". - Make it null-padded to "sz" bytes - */ - register arith sizearg = WA(nd->nd_type->tp_size); - - assert(nd->nd_type->tp_fund == T_STRING); - - if (sizearg != sz) { - /* null padding required */ - assert(sizearg < sz); - C_zer(sz - sizearg); - } - CodeString(nd); /* push address of string */ - C_loi(sizearg); -} - CodeExpr(nd, ds, true_label, false_label) register struct node *nd; register struct desig *ds; @@ -180,7 +159,7 @@ CodeExpr(nd, ds, true_label, false_label) if (true_label != 0) { /* Only for boolean expressions */ - CodeValue(ds, tp->tp_size); + CodeValue(ds, tp->tp_size, tp->tp_align); *ds = InitDesig; C_zne(true_label); C_bra(false_label); @@ -422,7 +401,16 @@ CodeParameters(param, arg) return; } if (left_type->tp_fund == T_STRING) { - CodePadString(left, tp->tp_size); + register arith szarg = WA(left_type->tp_size); + arith sz = WA(tp->tp_size); + + if (szarg != sz) { + /* null padding required */ + assert(szarg < sz); + C_zer(sz - szarg); + } + CodeString(left); /* push address of string */ + C_loi(szarg); return; } CodePExpr(left); @@ -480,6 +468,15 @@ CodeStd(nd) DoHIGH(left); break; + case S_SIZE: + case S_TSIZE: + assert(IsConformantArray(tp)); + DoHIGH(left); + C_inc(); + C_loc(tp->arr_elem->tp_size); + C_mlu(word_size); + break; + case S_ODD: CodePExpr(left); if (tp->tp_size == word_size) { @@ -951,7 +948,7 @@ CodeEl(nd, tp) } CodePExpr(nd) - struct node *nd; + register struct node *nd; { /* Generate code to push the value of the expression "nd" on the stack. @@ -960,7 +957,7 @@ CodePExpr(nd) designator = InitDesig; CodeExpr(nd, &designator, NO_LABEL, NO_LABEL); - CodeValue(&designator, nd->nd_type->tp_size); + CodeValue(&designator, nd->nd_type->tp_size, nd->nd_type->tp_align); } CodeDAddress(nd) @@ -988,7 +985,7 @@ CodeDStore(nd) designator = InitDesig; CodeDesig(nd, &designator); - CodeStore(&designator, nd->nd_type->tp_size); + CodeStore(&designator, nd->nd_type->tp_size, nd->nd_type->tp_align); } DoHIGH(nd) @@ -1006,8 +1003,9 @@ DoHIGH(nd) assert(IsConformantArray(df->df_type)); highoff = df->var_off /* base address and descriptor */ - + pointer_size /* skip base address */ - + word_size; /* skip first field of descriptor */ + + 2 * word_size; /* skip base and first field of + descriptor + */ if (df->df_scope->sc_level < proclevel) { C_lxa((arith) (proclevel - df->df_scope->sc_level)); C_lof(highoff); diff --git a/lang/m2/comp/cstoper.c b/lang/m2/comp/cstoper.c index 5f743b42d..878bc2c6f 100644 --- a/lang/m2/comp/cstoper.c +++ b/lang/m2/comp/cstoper.c @@ -469,7 +469,7 @@ cstcall(expp, call) break; case S_SIZE: - expp->nd_INT = WA(expr->nd_type->tp_size); + expp->nd_INT = expr->nd_type->tp_size; break; case S_VAL: diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g index 0f309aec4..c08bfe128 100644 --- a/lang/m2/comp/declar.g +++ b/lang/m2/comp/declar.g @@ -62,11 +62,11 @@ block(struct node **pnd;) : ; declaration: - CONST [ ConstantDeclaration ';' ]* + CONST [ %persistent ConstantDeclaration ';' ]* | - TYPE [ TypeDeclaration ';' ]* + TYPE [ %persistent TypeDeclaration ';' ]* | - VAR [ VariableDeclaration ';' ]* + VAR [ %persistent VariableDeclaration ';' ]* | ProcedureDeclaration ';' | @@ -239,7 +239,7 @@ RecordType(struct type **ptp;) close_scope(0); } FieldListSequence(scope, &size, &xalign) - { *ptp = standard_type(T_RECORD, xalign, WA(size)); + { *ptp = standard_type(T_RECORD, xalign, size); (*ptp)->rec_scope = scope; } END @@ -525,5 +525,8 @@ VariableDeclaration IdentAddr(struct node **pnd;) : IDENT { *pnd = MkLeaf(Name, &dot); } - ConstExpression(&((*pnd)->nd_left))? + [ '[' + ConstExpression(&((*pnd)->nd_left)) + ']' + ]? ; diff --git a/lang/m2/comp/def.c b/lang/m2/comp/def.c index e32e54848..c7e1d5b3c 100644 --- a/lang/m2/comp/def.c +++ b/lang/m2/comp/def.c @@ -131,6 +131,9 @@ define(id, scope, kind) } break; + case D_TYPE: + if (kind == D_FORWTYPE) return df; + break; case D_FORWTYPE: if (kind == D_FORWTYPE) return df; if (kind == D_TYPE) { diff --git a/lang/m2/comp/defmodule.c b/lang/m2/comp/defmodule.c index e1a861608..0e6614474 100644 --- a/lang/m2/comp/defmodule.c +++ b/lang/m2/comp/defmodule.c @@ -103,7 +103,7 @@ GetDefinitionModule(id, incr) df->mod_vis = vis; } } - else if (df == Defined) { + else if (df == Defined && level == 1) { error("cannot import from currently defined module"); df->df_kind = D_ERROR; } diff --git a/lang/m2/comp/desig.c b/lang/m2/comp/desig.c index 66d7ab4ec..09e66db07 100644 --- a/lang/m2/comp/desig.c +++ b/lang/m2/comp/desig.c @@ -24,39 +24,85 @@ extern int proclevel; struct desig InitDesig = {DSG_INIT, 0, 0}; -CodeValue(ds, size) +STATIC int +properly(ds, size, al) + register struct desig *ds; + arith size; +{ + /* Check if it is allowed to load or store the value indicated + by "ds" with LOI/STI. + - if the size is not either a multiple or a dividor of the + wordsize, then not. + - if the alignment is at least "word" then OK. + - if size is dividor of word_size and alignment >= size then OK. + - otherwise check alignment of address. This can only be done + with DSG_FIXED. + */ + + arith szmodword = size % word_size; /* 0 if multiple of wordsize */ + arith wordmodsz = word_size % size; /* 0 if dividor of wordsize */ + + if (szmodword && wordmodsz) return 0; + if (al >= word_size) return 1; + if (szmodword && al >= szmodword) return 1; + + return ds->dsg_kind == DSG_FIXED && + ((! szmodword && ds->dsg_offset % word_size == 0) || + (! wordmodsz && ds->dsg_offset % size == 0)); +} + +CodeValue(ds, size, al) register struct desig *ds; arith size; { /* Generate code to load the value of the designator described in "ds" */ + arith tmp = 0; switch(ds->dsg_kind) { case DSG_LOADED: break; case DSG_FIXED: - if (size == word_size) { - if (ds->dsg_name) { - C_loe_dnam(ds->dsg_name, ds->dsg_offset); + if (ds->dsg_offset % word_size == 0) { + if (size == word_size) { + if (ds->dsg_name) { + C_loe_dnam(ds->dsg_name,ds->dsg_offset); + } + else C_lol(ds->dsg_offset); + break; } - else C_lol(ds->dsg_offset); - break; - } - - if (size == dword_size) { - if (ds->dsg_name) { - C_lde_dnam(ds->dsg_name, ds->dsg_offset); + + if (size == dword_size) { + if (ds->dsg_name) { + C_lde_dnam(ds->dsg_name,ds->dsg_offset); + } + else C_ldl(ds->dsg_offset); + break; } - else C_ldl(ds->dsg_offset); - break; } /* Fall through */ case DSG_PLOADED: case DSG_PFIXED: - CodeAddress(ds); - C_loi(size); + if (properly(ds, size, al)) { + CodeAddress(ds); + C_loi(size); + break; + } + if (ds->dsg_kind == DSG_PLOADED) { + tmp = NewPtr(); + C_stl(tmp); + } + C_asp(-WA(size)); + if (!tmp) CodeAddress(ds); + else { + C_lol(tmp); + FreePtr(tmp); + } + C_loc(size); + C_cal("_load"); + C_asp(2 * word_size); break; case DSG_INDEXED: @@ -70,36 +116,46 @@ CodeValue(ds, size) ds->dsg_kind = DSG_LOADED; } -CodeStore(ds, size) +CodeStore(ds, size, al) register struct desig *ds; arith size; { /* Generate code to store the value on the stack in the designator described in "ds" */ + struct desig save; + save = *ds; switch(ds->dsg_kind) { case DSG_FIXED: - if (size == word_size) { - if (ds->dsg_name) { - C_ste_dnam(ds->dsg_name, ds->dsg_offset); + if (ds->dsg_offset % word_size == 0) { + if (size == word_size) { + if (ds->dsg_name) { + C_ste_dnam(ds->dsg_name,ds->dsg_offset); + } + else C_stl(ds->dsg_offset); + break; } - else C_stl(ds->dsg_offset); - break; - } - if (size == dword_size) { - if (ds->dsg_name) { - C_sde_dnam(ds->dsg_name, ds->dsg_offset); + if (size == dword_size) { + if (ds->dsg_name) { + C_sde_dnam(ds->dsg_name,ds->dsg_offset); + } + else C_sdl(ds->dsg_offset); + break; } - else C_sdl(ds->dsg_offset); - break; } /* Fall through */ case DSG_PLOADED: case DSG_PFIXED: - CodeAddress(ds); - C_sti(size); + CodeAddress(&save); + if (properly(ds, size, al)) { + C_sti(size); + break; + } + C_loc(size); + C_cal("_store"); + C_asp(2 * word_size + WA(size)); break; case DSG_INDEXED: @@ -113,6 +169,146 @@ CodeStore(ds, size) ds->dsg_kind = DSG_INIT; } +CodeCopy(lhs, rhs, sz, psize) + register struct desig *lhs, *rhs; + arith sz, *psize; +{ + struct desig l, r; + + l = *lhs; r = *rhs; + *psize -= sz; + lhs->dsg_offset += sz; + rhs->dsg_offset += sz; + CodeAddress(&r); + C_loi(sz); + CodeAddress(&l); + C_sti(sz); +} + +CodeMove(rhs, left, rtp) + register struct desig *rhs; + register struct node *left; + struct type *rtp; +{ + struct desig dsl; + register struct desig *lhs = &dsl; + register struct type *tp = left->nd_type; + int loadedflag = 0; + + dsl = InitDesig; + + /* Generate code for an assignment. Testing of type + compatibility and the like is already done. + Go through some (considerable) trouble to see if a BLM can be + generated. + */ + + switch(rhs->dsg_kind) { + case DSG_LOADED: + CodeDesig(left, lhs); + CodeAddress(lhs); + if (rtp->tp_fund == T_STRING) { + C_loc(rtp->tp_size); + C_loc(tp->tp_size); + C_cal("_StringAssign"); + C_asp(word_size << 2); + return; + } + CodeStore(lhs, tp->tp_size, tp->tp_align); + return; + case DSG_PLOADED: + case DSG_PFIXED: + CodeAddress(rhs); + if (tp->tp_size % word_size == 0 && tp->tp_align >= word_size) { + CodeDesig(left, lhs); + CodeAddress(lhs); + C_blm(tp->tp_size); + return; + } + CodeValue(rhs, tp->tp_size, tp->tp_align); + CodeDStore(left); + return; + case DSG_FIXED: + CodeDesig(left, lhs); + if (lhs->dsg_kind == DSG_FIXED && + lhs->dsg_offset % word_size == + rhs->dsg_offset % word_size) { + register arith sz; + arith size = tp->tp_size; + + while (size && (sz = (lhs->dsg_offset % word_size))) { + /* First copy up to word-aligned + boundaries + */ + if (sz < 0) sz = -sz; /* bloody '%' */ + while (word_size % sz) sz--; + CodeCopy(lhs, rhs, sz, &size); + } + if (size > 3*dword_size) { + /* Do a block move + */ + struct desig l, r; + + sz = (size / word_size) * word_size; + l = *lhs; r = *rhs; + CodeAddress(&r); + CodeAddress(&l); + C_blm(sz); + rhs->dsg_offset += sz; + lhs->dsg_offset += sz; + size -= sz; + } + else for (sz = dword_size; sz; sz -= word_size) { + while (size >= sz) { + /* Then copy dwords, words. + Depend on peephole optimizer + */ + CodeCopy(lhs, rhs, sz, &size); + } + } + sz = word_size; + while (size && --sz) { + /* And then copy remaining parts + */ + while (word_size % sz) sz--; + while (size >= sz) { + CodeCopy(lhs, rhs, sz, &size); + } + } + return; + } + if (lhs->dsg_kind == DSG_PLOADED || + lhs->dsg_kind == DSG_INDEXED) { + CodeAddress(lhs); + loadedflag = 1; + } + if (tp->tp_size % word_size == 0 && tp->tp_align >= word_size) { + CodeAddress(rhs); + if (loadedflag) C_exg(pointer_size); + else CodeAddress(lhs); + C_blm(tp->tp_size); + return; + } + { + arith tmp; + + if (loadedflag) { + tmp = NewPtr(); + lhs->dsg_offset = tmp; + lhs->dsg_name = 0; + lhs->dsg_kind = DSG_PFIXED; + C_stl(tmp); /* address of lhs */ + } + CodeValue(rhs, tp->tp_size, tp->tp_align); + CodeStore(lhs, tp->tp_size, tp->tp_align); + if (loadedflag) FreePtr(tmp); + return; + } + default: + crash("CodeMove"); + } +} + CodeAddress(ds) register struct desig *ds; { @@ -136,8 +332,11 @@ CodeAddress(ds) break; case DSG_PFIXED: - ds->dsg_kind = DSG_FIXED; - CodeValue(ds, pointer_size); + if (ds->dsg_name) { + C_loe_dnam(ds->dsg_name,ds->dsg_offset); + break; + } + C_lol(ds->dsg_offset); break; case DSG_INDEXED: @@ -353,7 +552,7 @@ CodeDesig(nd, ds) case DSG_INDEXED: case DSG_PLOADED: case DSG_PFIXED: - CodeValue(ds, pointer_size); + CodeValue(ds, pointer_size, pointer_align); ds->dsg_kind = DSG_PLOADED; ds->dsg_offset = 0; break; diff --git a/lang/m2/comp/enter.c b/lang/m2/comp/enter.c index 04a948e14..0680a0b5f 100644 --- a/lang/m2/comp/enter.c +++ b/lang/m2/comp/enter.c @@ -112,9 +112,11 @@ EnterVarList(Idlist, type, local) if (idlist->nd_left) { /* An address was supplied */ + register struct type *tp = idlist->nd_left->nd_type; + df->var_addrgiven = 1; df->df_flags |= D_NOREG; - if (idlist->nd_left->nd_type != card_type) { + if (tp != error_type && !(tp->tp_fund & T_CARDINAL)){ node_error(idlist->nd_left, "illegal type for address"); } @@ -224,6 +226,11 @@ DoImport(df, scope) /* Also import all definitions that are exported from this module */ + if (df->mod_vis == CurrVis) { + error("cannot import current module \"%s\"", + df->df_idf->id_text); + return; + } for (df = df->mod_vis->sc_scope->sc_def; df; df = df->df_nextinscope) { @@ -391,11 +398,16 @@ EnterFromImportList(Idlist, FromDef, FromId) break; case D_MODULE: vis = FromDef->mod_vis; + if (vis == CurrVis) { +node_error(FromId, "cannot import from current module \"%s\"", + FromDef->df_idf->id_text); + return; + } break; default: - node_error(FromId, "identifier \"%s\" does not represent a module", +node_error(FromId, "identifier \"%s\" does not represent a module", FromDef->df_idf->id_text); - break; + return; } for (; idlist; idlist = idlist->next) { diff --git a/lang/m2/comp/program.g b/lang/m2/comp/program.g index b45e5f9c4..f7eed0d12 100644 --- a/lang/m2/comp/program.g +++ b/lang/m2/comp/program.g @@ -157,10 +157,11 @@ definition register struct def *df; struct def *dummy; } : - CONST [ ConstantDeclaration ';' ]* + CONST [ %persistent ConstantDeclaration ';' ]* | TYPE - [ IDENT { df = define(dot.TOK_IDF, CurrentScope, D_TYPE); } + [ %persistent + IDENT { df = define(dot.TOK_IDF, CurrentScope, D_TYPE); } [ '=' type(&(df->df_type)) | /* empty */ /* @@ -175,7 +176,7 @@ definition ';' ]* | - VAR [ VariableDeclaration ';' ]* + VAR [ %persistent VariableDeclaration ';' ]* | ProcedureHeading(&dummy, D_PROCHEAD) ';' diff --git a/lang/m2/comp/scope.C b/lang/m2/comp/scope.C index a81557f43..e94f895cf 100644 --- a/lang/m2/comp/scope.C +++ b/lang/m2/comp/scope.C @@ -71,6 +71,10 @@ Forward(tk, ptp) */ register struct def *df = define(tk->nd_IDF, CurrentScope, D_FORWTYPE); + if (df->df_kind == D_TYPE) { + ptp->next = df->df_type; + return; + } df->df_forw_type = ptp; df->df_forw_node = tk; } @@ -106,8 +110,17 @@ chk_forw(pdf) while (df = *pdf) { if (df->df_kind == D_FORWTYPE) { -node_error(df->df_forw_node, "type \"%s\" not declared", df->df_idf->id_text); - FreeNode(df->df_forw_node); + register struct def *df1 = df; + + *pdf = df->df_nextinscope; + RemoveFromIdList(df); + df = lookfor(df->df_forw_node, CurrVis, 1); + if (! df->df_kind & (D_ERROR|D_FTYPE|D_TYPE)) { +node_error(df1->df_forw_node, "\"%s\" is not a type", df1->df_idf->id_text); + } + df1->df_forw_type->next = df->df_type; + FreeNode(df1->df_forw_node); + free_def(df1); } else if (df->df_kind == D_FTYPE) { df->df_kind = D_TYPE; diff --git a/lang/m2/comp/statement.g b/lang/m2/comp/statement.g index 45dc3993d..875ea1ea2 100644 --- a/lang/m2/comp/statement.g +++ b/lang/m2/comp/statement.g @@ -31,7 +31,12 @@ statement(register struct node **pnd;) } ActualParameters(&(nd->nd_right))? | - BECOMES { nd = MkNode(Stat, *pnd, NULLNODE, &dot); } + [ BECOMES + | '=' { error("':=' expected instead of '='"); + DOT = BECOMES; + } + ] + { nd = MkNode(Stat, *pnd, NULLNODE, &dot); } expression(&(nd->nd_right)) ] { *pnd = nd; } diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c index e513174bf..4a6da47e6 100644 --- a/lang/m2/comp/walk.c +++ b/lang/m2/comp/walk.c @@ -221,9 +221,11 @@ WalkProcedure(procedure) /* upper - lower */ C_inc(); /* gives number of elements */ C_loc(tp->arr_elem->tp_size); - C_cal("_wa"); - C_asp(dword_size); - C_lfr(word_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); @@ -241,25 +243,16 @@ WalkProcedure(procedure) */ C_ass(word_size); /* adjusted stack pointer */ - C_lor((arith) 1); - /* destination address (sp), - also assumes stack grows - downwards ??? - */ - C_lal(param->par_def->var_off); - C_loi(pointer_size); + C_lol(param->par_def->var_off); /* push source address */ - C_exg(pointer_size); - /* exchange them */ C_lol(tmpvar); /* push size */ - C_bls(word_size); - /* copy */ + C_cal("_load"); /* copy */ + C_asp(2 * word_size); C_lor((arith) 1); /* push new address of array ... downwards ... ??? */ - C_lal(param->par_def->var_off); - C_sti(pointer_size); + C_stl(param->par_def->var_off); FreeInt(tmpvar); } } @@ -529,7 +522,7 @@ WalkStat(nd, exit_label) */ ds.dsg_offset = NewPtr(); ds.dsg_name = 0; - CodeStore(&ds, pointer_size); + CodeStore(&ds, pointer_size, pointer_align); ds.dsg_kind = DSG_PFIXED; /* the record is indirectly available */ wds.w_desig = ds; @@ -709,7 +702,7 @@ DoAssign(nd, left, right) it sais that the left hand side is evaluated first. DAMN THE BOOK! */ - struct desig dsl, dsr; + struct desig dsr; register struct type *rtp, *ltp; if (! (ChkExpression(right) & ChkVariable(left))) return; @@ -724,34 +717,18 @@ DoAssign(nd, left, right) return; } +#define StackNeededFor(ds) ((ds)->dsg_kind == DSG_PLOADED \ + || (ds)->dsg_kind == DSG_INDEXED) CodeExpr(right, &dsr, NO_LABEL, NO_LABEL); - if (complex(rtp)) CodeAddress(&dsr); + if (complex(rtp)) { + if (StackNeededFor(&dsr)) CodeAddress(&dsr); + } else { - CodeValue(&dsr, rtp->tp_size); - RangeCheck(ltp, rtp); + CodeValue(&dsr, rtp->tp_size, rtp->tp_align); CodeCoercion(rtp, ltp); + RangeCheck(ltp, rtp); } - dsl = InitDesig; - CodeDesig(left, &dsl); - - /* Generate code for an assignment. Testing of type - compatibility and the like is already done. - */ - - if (dsr.dsg_kind == DSG_LOADED) { - if (rtp->tp_fund == T_STRING) { - CodeAddress(&dsl); - C_loc(rtp->tp_size); - C_loc(ltp->tp_size); - C_cal("_StringAssign"); - C_asp((int_size << 1) + (pointer_size << 1)); - return; - } - CodeStore(&dsl, ltp->tp_size); - return; - } - CodeAddress(&dsl); - C_blm(ltp->tp_size); + CodeMove(&dsr, left, rtp); } RegisterMessages(df)