many bug fixes, and added flexibility in alignments
This commit is contained in:
parent
da54801353
commit
a0c21bf820
|
@ -1 +1 @@
|
||||||
char Version[] = "ACK Modula-2 compiler Version 0.8";
|
static char Version[] = "ACK Modula-2 compiler Version 0.9";
|
||||||
|
|
|
@ -540,7 +540,7 @@ ChkProcCall(expp)
|
||||||
if (left->nd_symb == STRING) {
|
if (left->nd_symb == STRING) {
|
||||||
TryToString(left, TypeOfParam(param));
|
TryToString(left, TypeOfParam(param));
|
||||||
}
|
}
|
||||||
else if (! TstParCompat(RemoveEqual(TypeOfParam(param)),
|
if (! TstParCompat(RemoveEqual(TypeOfParam(param)),
|
||||||
left->nd_type,
|
left->nd_type,
|
||||||
IsVarParam(param),
|
IsVarParam(param),
|
||||||
left)) {
|
left)) {
|
||||||
|
@ -1017,10 +1017,14 @@ ChkStandard(expp, left)
|
||||||
case S_TSIZE: /* ??? */
|
case S_TSIZE: /* ??? */
|
||||||
case S_SIZE:
|
case S_SIZE:
|
||||||
expp->nd_type = intorcard_type;
|
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;
|
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;
|
break;
|
||||||
|
|
||||||
case S_TRUNC:
|
case S_TRUNC:
|
||||||
|
|
|
@ -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)
|
CodeExpr(nd, ds, true_label, false_label)
|
||||||
register struct node *nd;
|
register struct node *nd;
|
||||||
register struct desig *ds;
|
register struct desig *ds;
|
||||||
|
@ -180,7 +159,7 @@ CodeExpr(nd, ds, true_label, false_label)
|
||||||
if (true_label != 0) {
|
if (true_label != 0) {
|
||||||
/* Only for boolean expressions
|
/* Only for boolean expressions
|
||||||
*/
|
*/
|
||||||
CodeValue(ds, tp->tp_size);
|
CodeValue(ds, tp->tp_size, tp->tp_align);
|
||||||
*ds = InitDesig;
|
*ds = InitDesig;
|
||||||
C_zne(true_label);
|
C_zne(true_label);
|
||||||
C_bra(false_label);
|
C_bra(false_label);
|
||||||
|
@ -422,7 +401,16 @@ CodeParameters(param, arg)
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
if (left_type->tp_fund == T_STRING) {
|
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;
|
return;
|
||||||
}
|
}
|
||||||
CodePExpr(left);
|
CodePExpr(left);
|
||||||
|
@ -480,6 +468,15 @@ CodeStd(nd)
|
||||||
DoHIGH(left);
|
DoHIGH(left);
|
||||||
break;
|
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:
|
case S_ODD:
|
||||||
CodePExpr(left);
|
CodePExpr(left);
|
||||||
if (tp->tp_size == word_size) {
|
if (tp->tp_size == word_size) {
|
||||||
|
@ -951,7 +948,7 @@ CodeEl(nd, tp)
|
||||||
}
|
}
|
||||||
|
|
||||||
CodePExpr(nd)
|
CodePExpr(nd)
|
||||||
struct node *nd;
|
register struct node *nd;
|
||||||
{
|
{
|
||||||
/* Generate code to push the value of the expression "nd"
|
/* Generate code to push the value of the expression "nd"
|
||||||
on the stack.
|
on the stack.
|
||||||
|
@ -960,7 +957,7 @@ CodePExpr(nd)
|
||||||
|
|
||||||
designator = InitDesig;
|
designator = InitDesig;
|
||||||
CodeExpr(nd, &designator, NO_LABEL, NO_LABEL);
|
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)
|
CodeDAddress(nd)
|
||||||
|
@ -988,7 +985,7 @@ CodeDStore(nd)
|
||||||
|
|
||||||
designator = InitDesig;
|
designator = InitDesig;
|
||||||
CodeDesig(nd, &designator);
|
CodeDesig(nd, &designator);
|
||||||
CodeStore(&designator, nd->nd_type->tp_size);
|
CodeStore(&designator, nd->nd_type->tp_size, nd->nd_type->tp_align);
|
||||||
}
|
}
|
||||||
|
|
||||||
DoHIGH(nd)
|
DoHIGH(nd)
|
||||||
|
@ -1006,8 +1003,9 @@ DoHIGH(nd)
|
||||||
assert(IsConformantArray(df->df_type));
|
assert(IsConformantArray(df->df_type));
|
||||||
|
|
||||||
highoff = df->var_off /* base address and descriptor */
|
highoff = df->var_off /* base address and descriptor */
|
||||||
+ pointer_size /* skip base address */
|
+ 2 * word_size; /* skip base and first field of
|
||||||
+ word_size; /* skip first field of descriptor */
|
descriptor
|
||||||
|
*/
|
||||||
if (df->df_scope->sc_level < proclevel) {
|
if (df->df_scope->sc_level < proclevel) {
|
||||||
C_lxa((arith) (proclevel - df->df_scope->sc_level));
|
C_lxa((arith) (proclevel - df->df_scope->sc_level));
|
||||||
C_lof(highoff);
|
C_lof(highoff);
|
||||||
|
|
|
@ -469,7 +469,7 @@ cstcall(expp, call)
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case S_SIZE:
|
case S_SIZE:
|
||||||
expp->nd_INT = WA(expr->nd_type->tp_size);
|
expp->nd_INT = expr->nd_type->tp_size;
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case S_VAL:
|
case S_VAL:
|
||||||
|
|
|
@ -62,11 +62,11 @@ block(struct node **pnd;) :
|
||||||
;
|
;
|
||||||
|
|
||||||
declaration:
|
declaration:
|
||||||
CONST [ ConstantDeclaration ';' ]*
|
CONST [ %persistent ConstantDeclaration ';' ]*
|
||||||
|
|
|
|
||||||
TYPE [ TypeDeclaration ';' ]*
|
TYPE [ %persistent TypeDeclaration ';' ]*
|
||||||
|
|
|
|
||||||
VAR [ VariableDeclaration ';' ]*
|
VAR [ %persistent VariableDeclaration ';' ]*
|
||||||
|
|
|
|
||||||
ProcedureDeclaration ';'
|
ProcedureDeclaration ';'
|
||||||
|
|
|
|
||||||
|
@ -239,7 +239,7 @@ RecordType(struct type **ptp;)
|
||||||
close_scope(0);
|
close_scope(0);
|
||||||
}
|
}
|
||||||
FieldListSequence(scope, &size, &xalign)
|
FieldListSequence(scope, &size, &xalign)
|
||||||
{ *ptp = standard_type(T_RECORD, xalign, WA(size));
|
{ *ptp = standard_type(T_RECORD, xalign, size);
|
||||||
(*ptp)->rec_scope = scope;
|
(*ptp)->rec_scope = scope;
|
||||||
}
|
}
|
||||||
END
|
END
|
||||||
|
@ -525,5 +525,8 @@ VariableDeclaration
|
||||||
|
|
||||||
IdentAddr(struct node **pnd;) :
|
IdentAddr(struct node **pnd;) :
|
||||||
IDENT { *pnd = MkLeaf(Name, &dot); }
|
IDENT { *pnd = MkLeaf(Name, &dot); }
|
||||||
ConstExpression(&((*pnd)->nd_left))?
|
[ '['
|
||||||
|
ConstExpression(&((*pnd)->nd_left))
|
||||||
|
']'
|
||||||
|
]?
|
||||||
;
|
;
|
||||||
|
|
|
@ -131,6 +131,9 @@ define(id, scope, kind)
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
|
|
||||||
|
case D_TYPE:
|
||||||
|
if (kind == D_FORWTYPE) return df;
|
||||||
|
break;
|
||||||
case D_FORWTYPE:
|
case D_FORWTYPE:
|
||||||
if (kind == D_FORWTYPE) return df;
|
if (kind == D_FORWTYPE) return df;
|
||||||
if (kind == D_TYPE) {
|
if (kind == D_TYPE) {
|
||||||
|
|
|
@ -103,7 +103,7 @@ GetDefinitionModule(id, incr)
|
||||||
df->mod_vis = vis;
|
df->mod_vis = vis;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
else if (df == Defined) {
|
else if (df == Defined && level == 1) {
|
||||||
error("cannot import from currently defined module");
|
error("cannot import from currently defined module");
|
||||||
df->df_kind = D_ERROR;
|
df->df_kind = D_ERROR;
|
||||||
}
|
}
|
||||||
|
|
|
@ -24,39 +24,85 @@
|
||||||
extern int proclevel;
|
extern int proclevel;
|
||||||
struct desig InitDesig = {DSG_INIT, 0, 0};
|
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;
|
register struct desig *ds;
|
||||||
arith size;
|
arith size;
|
||||||
{
|
{
|
||||||
/* Generate code to load the value of the designator described
|
/* Generate code to load the value of the designator described
|
||||||
in "ds"
|
in "ds"
|
||||||
*/
|
*/
|
||||||
|
arith tmp = 0;
|
||||||
|
|
||||||
switch(ds->dsg_kind) {
|
switch(ds->dsg_kind) {
|
||||||
case DSG_LOADED:
|
case DSG_LOADED:
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case DSG_FIXED:
|
case DSG_FIXED:
|
||||||
if (size == word_size) {
|
if (ds->dsg_offset % word_size == 0) {
|
||||||
if (ds->dsg_name) {
|
if (size == word_size) {
|
||||||
C_loe_dnam(ds->dsg_name, ds->dsg_offset);
|
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 (size == dword_size) {
|
||||||
if (ds->dsg_name) {
|
if (ds->dsg_name) {
|
||||||
C_lde_dnam(ds->dsg_name, ds->dsg_offset);
|
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 */
|
/* Fall through */
|
||||||
case DSG_PLOADED:
|
case DSG_PLOADED:
|
||||||
case DSG_PFIXED:
|
case DSG_PFIXED:
|
||||||
CodeAddress(ds);
|
if (properly(ds, size, al)) {
|
||||||
C_loi(size);
|
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;
|
break;
|
||||||
|
|
||||||
case DSG_INDEXED:
|
case DSG_INDEXED:
|
||||||
|
@ -70,36 +116,46 @@ CodeValue(ds, size)
|
||||||
ds->dsg_kind = DSG_LOADED;
|
ds->dsg_kind = DSG_LOADED;
|
||||||
}
|
}
|
||||||
|
|
||||||
CodeStore(ds, size)
|
CodeStore(ds, size, al)
|
||||||
register struct desig *ds;
|
register struct desig *ds;
|
||||||
arith size;
|
arith size;
|
||||||
{
|
{
|
||||||
/* Generate code to store the value on the stack in the designator
|
/* Generate code to store the value on the stack in the designator
|
||||||
described in "ds"
|
described in "ds"
|
||||||
*/
|
*/
|
||||||
|
struct desig save;
|
||||||
|
|
||||||
|
save = *ds;
|
||||||
switch(ds->dsg_kind) {
|
switch(ds->dsg_kind) {
|
||||||
case DSG_FIXED:
|
case DSG_FIXED:
|
||||||
if (size == word_size) {
|
if (ds->dsg_offset % word_size == 0) {
|
||||||
if (ds->dsg_name) {
|
if (size == word_size) {
|
||||||
C_ste_dnam(ds->dsg_name, ds->dsg_offset);
|
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 (size == dword_size) {
|
||||||
if (ds->dsg_name) {
|
if (ds->dsg_name) {
|
||||||
C_sde_dnam(ds->dsg_name, ds->dsg_offset);
|
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 */
|
/* Fall through */
|
||||||
case DSG_PLOADED:
|
case DSG_PLOADED:
|
||||||
case DSG_PFIXED:
|
case DSG_PFIXED:
|
||||||
CodeAddress(ds);
|
CodeAddress(&save);
|
||||||
C_sti(size);
|
if (properly(ds, size, al)) {
|
||||||
|
C_sti(size);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
C_loc(size);
|
||||||
|
C_cal("_store");
|
||||||
|
C_asp(2 * word_size + WA(size));
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case DSG_INDEXED:
|
case DSG_INDEXED:
|
||||||
|
@ -113,6 +169,146 @@ CodeStore(ds, size)
|
||||||
ds->dsg_kind = DSG_INIT;
|
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)
|
CodeAddress(ds)
|
||||||
register struct desig *ds;
|
register struct desig *ds;
|
||||||
{
|
{
|
||||||
|
@ -136,8 +332,11 @@ CodeAddress(ds)
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case DSG_PFIXED:
|
case DSG_PFIXED:
|
||||||
ds->dsg_kind = DSG_FIXED;
|
if (ds->dsg_name) {
|
||||||
CodeValue(ds, pointer_size);
|
C_loe_dnam(ds->dsg_name,ds->dsg_offset);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
C_lol(ds->dsg_offset);
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case DSG_INDEXED:
|
case DSG_INDEXED:
|
||||||
|
@ -353,7 +552,7 @@ CodeDesig(nd, ds)
|
||||||
case DSG_INDEXED:
|
case DSG_INDEXED:
|
||||||
case DSG_PLOADED:
|
case DSG_PLOADED:
|
||||||
case DSG_PFIXED:
|
case DSG_PFIXED:
|
||||||
CodeValue(ds, pointer_size);
|
CodeValue(ds, pointer_size, pointer_align);
|
||||||
ds->dsg_kind = DSG_PLOADED;
|
ds->dsg_kind = DSG_PLOADED;
|
||||||
ds->dsg_offset = 0;
|
ds->dsg_offset = 0;
|
||||||
break;
|
break;
|
||||||
|
|
|
@ -112,9 +112,11 @@ EnterVarList(Idlist, type, local)
|
||||||
if (idlist->nd_left) {
|
if (idlist->nd_left) {
|
||||||
/* An address was supplied
|
/* An address was supplied
|
||||||
*/
|
*/
|
||||||
|
register struct type *tp = idlist->nd_left->nd_type;
|
||||||
|
|
||||||
df->var_addrgiven = 1;
|
df->var_addrgiven = 1;
|
||||||
df->df_flags |= D_NOREG;
|
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,
|
node_error(idlist->nd_left,
|
||||||
"illegal type for address");
|
"illegal type for address");
|
||||||
}
|
}
|
||||||
|
@ -224,6 +226,11 @@ DoImport(df, scope)
|
||||||
/* Also import all definitions that are exported from this
|
/* Also import all definitions that are exported from this
|
||||||
module
|
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;
|
for (df = df->mod_vis->sc_scope->sc_def;
|
||||||
df;
|
df;
|
||||||
df = df->df_nextinscope) {
|
df = df->df_nextinscope) {
|
||||||
|
@ -391,11 +398,16 @@ EnterFromImportList(Idlist, FromDef, FromId)
|
||||||
break;
|
break;
|
||||||
case D_MODULE:
|
case D_MODULE:
|
||||||
vis = FromDef->mod_vis;
|
vis = FromDef->mod_vis;
|
||||||
|
if (vis == CurrVis) {
|
||||||
|
node_error(FromId, "cannot import from current module \"%s\"",
|
||||||
|
FromDef->df_idf->id_text);
|
||||||
|
return;
|
||||||
|
}
|
||||||
break;
|
break;
|
||||||
default:
|
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);
|
FromDef->df_idf->id_text);
|
||||||
break;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
for (; idlist; idlist = idlist->next) {
|
for (; idlist; idlist = idlist->next) {
|
||||||
|
|
|
@ -157,10 +157,11 @@ definition
|
||||||
register struct def *df;
|
register struct def *df;
|
||||||
struct def *dummy;
|
struct def *dummy;
|
||||||
} :
|
} :
|
||||||
CONST [ ConstantDeclaration ';' ]*
|
CONST [ %persistent ConstantDeclaration ';' ]*
|
||||||
|
|
|
|
||||||
TYPE
|
TYPE
|
||||||
[ IDENT { df = define(dot.TOK_IDF, CurrentScope, D_TYPE); }
|
[ %persistent
|
||||||
|
IDENT { df = define(dot.TOK_IDF, CurrentScope, D_TYPE); }
|
||||||
[ '=' type(&(df->df_type))
|
[ '=' type(&(df->df_type))
|
||||||
| /* empty */
|
| /* empty */
|
||||||
/*
|
/*
|
||||||
|
@ -175,7 +176,7 @@ definition
|
||||||
';'
|
';'
|
||||||
]*
|
]*
|
||||||
|
|
|
|
||||||
VAR [ VariableDeclaration ';' ]*
|
VAR [ %persistent VariableDeclaration ';' ]*
|
||||||
|
|
|
|
||||||
ProcedureHeading(&dummy, D_PROCHEAD)
|
ProcedureHeading(&dummy, D_PROCHEAD)
|
||||||
';'
|
';'
|
||||||
|
|
|
@ -71,6 +71,10 @@ Forward(tk, ptp)
|
||||||
*/
|
*/
|
||||||
register struct def *df = define(tk->nd_IDF, CurrentScope, D_FORWTYPE);
|
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_type = ptp;
|
||||||
df->df_forw_node = tk;
|
df->df_forw_node = tk;
|
||||||
}
|
}
|
||||||
|
@ -106,8 +110,17 @@ chk_forw(pdf)
|
||||||
|
|
||||||
while (df = *pdf) {
|
while (df = *pdf) {
|
||||||
if (df->df_kind == D_FORWTYPE) {
|
if (df->df_kind == D_FORWTYPE) {
|
||||||
node_error(df->df_forw_node, "type \"%s\" not declared", df->df_idf->id_text);
|
register struct def *df1 = df;
|
||||||
FreeNode(df->df_forw_node);
|
|
||||||
|
*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) {
|
else if (df->df_kind == D_FTYPE) {
|
||||||
df->df_kind = D_TYPE;
|
df->df_kind = D_TYPE;
|
||||||
|
|
|
@ -31,7 +31,12 @@ statement(register struct node **pnd;)
|
||||||
}
|
}
|
||||||
ActualParameters(&(nd->nd_right))?
|
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))
|
expression(&(nd->nd_right))
|
||||||
]
|
]
|
||||||
{ *pnd = nd; }
|
{ *pnd = nd; }
|
||||||
|
|
|
@ -221,9 +221,11 @@ WalkProcedure(procedure)
|
||||||
/* upper - lower */
|
/* upper - lower */
|
||||||
C_inc(); /* gives number of elements */
|
C_inc(); /* gives number of elements */
|
||||||
C_loc(tp->arr_elem->tp_size);
|
C_loc(tp->arr_elem->tp_size);
|
||||||
C_cal("_wa");
|
C_mli(word_size);
|
||||||
C_asp(dword_size);
|
C_loc(word_size - 1);
|
||||||
C_lfr(word_size);
|
C_adi(word_size);
|
||||||
|
C_loc(word_size);
|
||||||
|
C_dvi(word_size);
|
||||||
/* size in words */
|
/* size in words */
|
||||||
C_loc(word_size);
|
C_loc(word_size);
|
||||||
C_mli(word_size);
|
C_mli(word_size);
|
||||||
|
@ -241,25 +243,16 @@ WalkProcedure(procedure)
|
||||||
*/
|
*/
|
||||||
C_ass(word_size);
|
C_ass(word_size);
|
||||||
/* adjusted stack pointer */
|
/* adjusted stack pointer */
|
||||||
C_lor((arith) 1);
|
C_lol(param->par_def->var_off);
|
||||||
/* destination address (sp),
|
|
||||||
also assumes stack grows
|
|
||||||
downwards ???
|
|
||||||
*/
|
|
||||||
C_lal(param->par_def->var_off);
|
|
||||||
C_loi(pointer_size);
|
|
||||||
/* push source address */
|
/* push source address */
|
||||||
C_exg(pointer_size);
|
|
||||||
/* exchange them */
|
|
||||||
C_lol(tmpvar); /* push size */
|
C_lol(tmpvar); /* push size */
|
||||||
C_bls(word_size);
|
C_cal("_load"); /* copy */
|
||||||
/* copy */
|
C_asp(2 * word_size);
|
||||||
C_lor((arith) 1);
|
C_lor((arith) 1);
|
||||||
/* push new address of array
|
/* push new address of array
|
||||||
... downwards ... ???
|
... downwards ... ???
|
||||||
*/
|
*/
|
||||||
C_lal(param->par_def->var_off);
|
C_stl(param->par_def->var_off);
|
||||||
C_sti(pointer_size);
|
|
||||||
FreeInt(tmpvar);
|
FreeInt(tmpvar);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -529,7 +522,7 @@ WalkStat(nd, exit_label)
|
||||||
*/
|
*/
|
||||||
ds.dsg_offset = NewPtr();
|
ds.dsg_offset = NewPtr();
|
||||||
ds.dsg_name = 0;
|
ds.dsg_name = 0;
|
||||||
CodeStore(&ds, pointer_size);
|
CodeStore(&ds, pointer_size, pointer_align);
|
||||||
ds.dsg_kind = DSG_PFIXED;
|
ds.dsg_kind = DSG_PFIXED;
|
||||||
/* the record is indirectly available */
|
/* the record is indirectly available */
|
||||||
wds.w_desig = ds;
|
wds.w_desig = ds;
|
||||||
|
@ -709,7 +702,7 @@ DoAssign(nd, left, right)
|
||||||
it sais that the left hand side is evaluated first.
|
it sais that the left hand side is evaluated first.
|
||||||
DAMN THE BOOK!
|
DAMN THE BOOK!
|
||||||
*/
|
*/
|
||||||
struct desig dsl, dsr;
|
struct desig dsr;
|
||||||
register struct type *rtp, *ltp;
|
register struct type *rtp, *ltp;
|
||||||
|
|
||||||
if (! (ChkExpression(right) & ChkVariable(left))) return;
|
if (! (ChkExpression(right) & ChkVariable(left))) return;
|
||||||
|
@ -724,34 +717,18 @@ DoAssign(nd, left, right)
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
#define StackNeededFor(ds) ((ds)->dsg_kind == DSG_PLOADED \
|
||||||
|
|| (ds)->dsg_kind == DSG_INDEXED)
|
||||||
CodeExpr(right, &dsr, NO_LABEL, NO_LABEL);
|
CodeExpr(right, &dsr, NO_LABEL, NO_LABEL);
|
||||||
if (complex(rtp)) CodeAddress(&dsr);
|
if (complex(rtp)) {
|
||||||
|
if (StackNeededFor(&dsr)) CodeAddress(&dsr);
|
||||||
|
}
|
||||||
else {
|
else {
|
||||||
CodeValue(&dsr, rtp->tp_size);
|
CodeValue(&dsr, rtp->tp_size, rtp->tp_align);
|
||||||
RangeCheck(ltp, rtp);
|
|
||||||
CodeCoercion(rtp, ltp);
|
CodeCoercion(rtp, ltp);
|
||||||
|
RangeCheck(ltp, rtp);
|
||||||
}
|
}
|
||||||
dsl = InitDesig;
|
CodeMove(&dsr, left, rtp);
|
||||||
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);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
RegisterMessages(df)
|
RegisterMessages(df)
|
||||||
|
|
Loading…
Reference in a new issue