-char Version[] = "ACK Modula-2 compiler Version 0.8";
+static char Version[] = "ACK Modula-2 compiler Version 0.9";
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)) {
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:
}
}
-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;
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);
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);
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) {
}
CodePExpr(nd)
- struct node *nd;
+ register struct node *nd;
{
/* Generate code to push the value of the expression "nd"
on the stack.
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)
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)
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);
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:
;
declaration:
- CONST [ ConstantDeclaration ';' ]*
+ CONST [ %persistent ConstantDeclaration ';' ]*
|
- TYPE [ TypeDeclaration ';' ]*
+ TYPE [ %persistent TypeDeclaration ';' ]*
|
- VAR [ VariableDeclaration ';' ]*
+ VAR [ %persistent VariableDeclaration ';' ]*
|
ProcedureDeclaration ';'
|
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
IdentAddr(struct node **pnd;) :
IDENT { *pnd = MkLeaf(Name, &dot); }
- ConstExpression(&((*pnd)->nd_left))?
+ [ '['
+ ConstExpression(&((*pnd)->nd_left))
+ ']'
+ ]?
;
}
break;
+ case D_TYPE:
+ if (kind == D_FORWTYPE) return df;
+ break;
case D_FORWTYPE:
if (kind == D_FORWTYPE) return df;
if (kind == D_TYPE) {
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;
}
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:
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:
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;
{
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:
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;
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");
}
/* 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) {
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) {
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 */
/*
';'
]*
|
- VAR [ VariableDeclaration ';' ]*
+ VAR [ %persistent VariableDeclaration ';' ]*
|
ProcedureHeading(&dummy, D_PROCHEAD)
';'
*/
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;
}
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;
}
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; }
/* 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);
*/
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);
}
}
*/
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;
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;
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)
public / ack.git / commitdiff