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

many bug fixes, and added flexibility in alignments

Browse source
This commit is contained in:
ceriel 1986-11-28 11:59:08 +00:00
parent da54801353
commit a0c21bf820
13 changed files with 337 additions and 122 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -1 +1 @@
char Version[] = "ACK Modula-2 compiler Version 0.8";
static char Version[] = "ACK Modula-2 compiler Version 0.9";

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

@ -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:

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

@ -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);

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

@ -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:

13
lang/m2/comp/declar.g
View file

@ -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))
']'
]?
;

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

@ -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) {

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

@ -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;
}

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

@ -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;

18
lang/m2/comp/enter.c
View file

@ -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) {

7
lang/m2/comp/program.g
View file

@ -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)
';'

17
lang/m2/comp/scope.C
View file

@ -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;

7
lang/m2/comp/statement.g
View file

@ -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; }

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

@ -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)