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

too many changes: some cosmetic; some for 2/4; some for added options

Browse source
This commit is contained in:
ceriel 1988-03-21 17:22:26 +00:00
parent 0976dfa3b9
commit 795a078d08
6 changed files with 184 additions and 117 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -256,7 +256,7 @@ DeclProc(type, id)
df->for_name = id->id_text; df->for_name = id->id_text;
} }
else { else {
sprint(buf,"%s_%s",CurrentScope->sc_name,id->id_text); sprint(buf,"_%s_%s",CurrentScope->sc_name,id->id_text);
df->for_name = Salloc(buf, (unsigned) (strlen(buf)+1)); df->for_name = Salloc(buf, (unsigned) (strlen(buf)+1));
} }
if (CurrVis == Defined->mod_vis) { if (CurrVis == Defined->mod_vis) {

2
lang/m2/comp/desig.H
View file

@ -17,7 +17,7 @@
*/ */
struct desig { struct desig {
int dsg_kind; short dsg_kind;
#define DSG_INIT 0 /* don't know anything yet */ #define DSG_INIT 0 /* don't know anything yet */
#define DSG_LOADED 1 /* designator loaded on top of the stack */ #define DSG_LOADED 1 /* designator loaded on top of the stack */
#define DSG_PLOADED 2 /* designator accessible through pointer on #define DSG_PLOADED 2 /* designator accessible through pointer on

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

@ -34,13 +34,18 @@
#include "walk.h" #include "walk.h"
extern int proclevel; extern int proclevel;
extern arith NewPtr();
extern char options[];
int int
WordOrDouble(ds, size) WordOrDouble(ds, size)
register t_desig *ds; t_desig *ds;
arith size; arith size;
{ {
if ((int) (ds->dsg_offset) % (int) word_size == 0) { /* Check if designator is suitable for word or double-word
operation
*/
if ((int) (ds->dsg_offset) % word_align == 0) {
if (size == word_size) return 1; if (size == word_size) return 1;
if (size == dword_size) return 2; if (size == dword_size) return 2;
} }
@ -52,6 +57,9 @@ DoLoad(ds, size)
register t_desig *ds; register t_desig *ds;
arith size; arith size;
{ {
/* Try to load designator with word or double-word operation.
Return 0 if not done
*/
switch (WordOrDouble(ds, size)) { switch (WordOrDouble(ds, size)) {
default: default:
return 0; return 0;
@ -76,6 +84,9 @@ DoStore(ds, size)
register t_desig *ds; register t_desig *ds;
arith size; arith size;
{ {
/* Try to store designator with word or double-word operation.
Return 0 if not done
*/
switch (WordOrDouble(ds, size)) { switch (WordOrDouble(ds, size)) {
default: default:
return 0; return 0;
@ -95,32 +106,55 @@ DoStore(ds, size)
return 1; return 1;
} }
STATIC int int
properly(ds, tp) word_multiple(tp)
register t_desig *ds;
register t_type *tp; register t_type *tp;
{ {
/* Check if it is allowed to load or store the value indicated /* Return 1 if the type indicated by tp has a size that is a
by "ds" with LOI/STI. multiple of the word_size and is also word_aligned
- if the size is not either a multiple or a dividor of the */
wordsize, then not. return (int)(tp->tp_size) % (int)word_size == 0 &&
- if the alignment is at least "word" then OK. tp->tp_align >= word_align;
- 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. int
word_dividor(tp)
register t_type *tp;
{
/* Return 1 if the type indicated by tp has a size that is a proper
dividor of the word_size, and has alignment >= size or
alignment >= word_align
*/
return tp->tp_size < word_size &&
(int)word_size % (int)(tp->tp_size) == 0 &&
(tp->tp_align >= word_align ||
tp->tp_align >= (int)(tp->tp_size));
}
#define USE_LOI_STI 0
#define USE_LOS_STS 1
#define USE_LOAD_STORE 2
#define USE_BLM 3 /* like USE_LOI_STI, but more restricted:
multiple of word_size only
*/
STATIC int
type_to_stack(tp)
register t_type *tp;
{
/* Find out how to load or store the value indicated by "ds".
There are three ways:
- with LOI/STI
- with LOS/STS
- with calls to _load/_store
*/ */
int szmodword = (int) (tp->tp_size) % (int) word_size; if (! word_multiple(tp)) {
/* 0 if multiple of wordsize */ if (word_dividor(tp)) return USE_LOI_STI;
int wordmodsz = word_size % tp->tp_size;/* 0 if dividor of wordsize */ return USE_LOAD_STORE;
}
if (szmodword && wordmodsz) return 0; if (! fit(tp->tp_size, (int) word_size)) return USE_LOS_STS;
if (tp->tp_align >= word_align) return 1; return USE_BLM;
if (szmodword && tp->tp_align >= szmodword) return 1;
return ds->dsg_kind == DSG_FIXED &&
((! szmodword && (int) (ds->dsg_offset) % word_align == 0) ||
(! wordmodsz && ds->dsg_offset % tp->tp_size == 0));
} }
CodeValue(ds, tp) CodeValue(ds, tp)
@ -128,7 +162,7 @@ CodeValue(ds, tp)
register t_type *tp; register t_type *tp;
{ {
/* 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 sz; arith sz;
@ -141,27 +175,41 @@ CodeValue(ds, tp)
/* Fall through */ /* Fall through */
case DSG_PLOADED: case DSG_PLOADED:
case DSG_PFIXED: case DSG_PFIXED:
sz = WA(tp->tp_size); switch (type_to_stack(tp)) {
if (properly(ds, tp)) { case USE_BLM:
case USE_LOI_STI:
CodeAddress(ds); CodeAddress(ds);
C_loi(tp->tp_size); C_loi(tp->tp_size);
break; break;
} case USE_LOS_STS:
if (ds->dsg_kind == DSG_PLOADED) { CodeAddress(ds);
sz -= pointer_size; CodeConst(tp->tp_size, (int)pointer_size);
C_los(pointer_size);
break;
case USE_LOAD_STORE:
sz = WA(tp->tp_size);
if (ds->dsg_kind == DSG_PLOADED) {
arith tmp = NewPtr();
C_asp(-sz); CodeAddress(ds);
C_lor((arith) 1); C_lal(tmp);
C_adp(sz); C_sti(pointer_size);
C_loi(pointer_size); CodeConst(-sz, (int) pointer_size);
C_ass(pointer_size);
C_lal(tmp);
C_loi(pointer_size);
FreePtr(tmp);
}
else {
CodeConst(-sz, (int) pointer_size);
C_ass(pointer_size);
}
CodeAddress(ds);
CodeConst(tp->tp_size, (int) pointer_size);
C_cal("_load");
C_asp(pointer_size + pointer_size);
break;
} }
else {
C_asp(-sz);
}
CodeAddress(ds);
C_loc(tp->tp_size);
C_cal("_load");
C_asp(2 * word_size);
break; break;
case DSG_INDEXED: case DSG_INDEXED:
@ -178,6 +226,8 @@ CodeValue(ds, tp)
ChkForFOR(nd) ChkForFOR(nd)
t_node *nd; t_node *nd;
{ {
/* Check for an assignment to a FOR-loop control variable
*/
if (nd->nd_class == Def) { if (nd->nd_class == Def) {
register t_def *df = nd->nd_def; register t_def *df = nd->nd_def;
@ -186,6 +236,7 @@ ChkForFOR(nd)
W_ORDINARY, W_ORDINARY,
"assignment to FOR-loop control variable"); "assignment to FOR-loop control variable");
df->df_flags &= ~D_FORLOOP; df->df_flags &= ~D_FORLOOP;
/* only procude warning once */
} }
} }
} }
@ -208,13 +259,23 @@ CodeStore(ds, tp)
case DSG_PLOADED: case DSG_PLOADED:
case DSG_PFIXED: case DSG_PFIXED:
CodeAddress(&save); CodeAddress(&save);
if (properly(ds, tp)) { switch (type_to_stack(tp)) {
case USE_BLM:
case USE_LOI_STI:
C_sti(tp->tp_size); C_sti(tp->tp_size);
break; break;
case USE_LOS_STS:
CodeConst(tp->tp_size, (int) pointer_size);
C_sts(pointer_size);
break;
case USE_LOAD_STORE:
CodeConst(tp->tp_size, (int) pointer_size);
C_cal("_store");
CodeConst(pointer_size + pointer_size + WA(tp->tp_size),
(int) pointer_size);
C_ass(pointer_size);
break;
} }
C_loc(tp->tp_size);
C_cal("_store");
C_asp(2 * word_size + WA(tp->tp_size));
break; break;
case DSG_INDEXED: case DSG_INDEXED:
@ -232,6 +293,9 @@ CodeCopy(lhs, rhs, sz, psize)
register t_desig *lhs, *rhs; register t_desig *lhs, *rhs;
arith sz, *psize; arith sz, *psize;
{ {
/* Do part of a copy, which is assumed to be "reasonable",
so that it can be done with LOI/STI or BLM.
*/
t_desig l, r; t_desig l, r;
l = *lhs; r = *rhs; l = *lhs; r = *rhs;
@ -239,9 +303,15 @@ CodeCopy(lhs, rhs, sz, psize)
lhs->dsg_offset += sz; lhs->dsg_offset += sz;
rhs->dsg_offset += sz; rhs->dsg_offset += sz;
CodeAddress(&r); CodeAddress(&r);
C_loi(sz); if (sz <= dword_size) {
CodeAddress(&l); C_loi(sz);
C_sti(sz); CodeAddress(&l);
C_sti(sz);
}
else {
CodeAddress(&l);
C_blm(sz);
}
} }
CodeMove(rhs, left, rtp) CodeMove(rhs, left, rtp)
@ -249,53 +319,42 @@ CodeMove(rhs, left, rtp)
register t_node *left; register t_node *left;
t_type *rtp; t_type *rtp;
{ {
register t_desig *lhs = new_desig();
register t_type *tp = left->nd_type;
int loadedflag = 0;
/* Generate code for an assignment. Testing of type /* Generate code for an assignment. Testing of type
compatibility and the like is already done. compatibility and the like is already done.
Go through some (considerable) trouble to see if a BLM can be Go through some (considerable) trouble to see if a BLM can be
generated. generated.
*/ */
register t_desig *lhs = new_desig();
register t_type *tp = left->nd_type;
ChkForFOR(left); ChkForFOR(left);
switch(rhs->dsg_kind) { switch(rhs->dsg_kind) {
case DSG_LOADED: case DSG_LOADED:
CodeDesig(left, lhs); CodeDesig(left, lhs);
if (rtp->tp_fund == T_STRING) { if (rtp->tp_fund == T_STRING) {
/* size of a string literal fits in an
int of size word_size
*/
CodeAddress(lhs); CodeAddress(lhs);
C_loc(rtp->tp_size); C_loc(rtp->tp_size);
C_loc(tp->tp_size); C_loc(tp->tp_size);
C_cal("_StringAssign"); C_cal("_StringAssign");
C_asp(word_size << 2); C_asp(pointer_size + pointer_size + dword_size);
break; break;
} }
CodeStore(lhs, tp); CodeStore(lhs, tp);
break; break;
case DSG_PLOADED:
case DSG_PFIXED:
CodeAddress(rhs);
if ((int) (tp->tp_size) % (int) word_size == 0 &&
tp->tp_align >= (int) word_size) {
CodeDesig(left, lhs);
CodeAddress(lhs);
C_blm(tp->tp_size);
break;
}
CodeValue(rhs, tp);
CodeDStore(left);
break;
case DSG_FIXED: case DSG_FIXED:
CodeDesig(left, lhs);
if (lhs->dsg_kind == DSG_FIXED && if (lhs->dsg_kind == DSG_FIXED &&
fit(tp->tp_size, (int) word_size) &&
(int) (lhs->dsg_offset) % (int) word_size == (int) (lhs->dsg_offset) % (int) word_size ==
(int) (rhs->dsg_offset) % (int) word_size) { (int) (rhs->dsg_offset) % (int) word_size) {
register int sz; register int sz;
arith size = tp->tp_size; arith size = tp->tp_size;
CodeDesig(left, lhs);
while (size && while (size &&
(sz = ((int)(lhs->dsg_offset) % (int)word_size))) { (sz = ((int)(lhs->dsg_offset)%(int)word_size))) {
/* First copy up to word-aligned /* First copy up to word-aligned
boundaries boundaries
*/ */
@ -306,19 +365,13 @@ CodeMove(rhs, left, rtp)
if (size > 3*dword_size) { if (size > 3*dword_size) {
/* Do a block move /* Do a block move
*/ */
t_desig l, r;
arith sz; arith sz;
sz = (size / word_size) * word_size; sz = size - size % word_size;
l = *lhs; r = *rhs; CodeCopy(lhs, rhs, sz, &size);
CodeAddress(&r);
CodeAddress(&l);
C_blm((arith) sz);
rhs->dsg_offset += sz;
lhs->dsg_offset += sz;
size -= sz;
} }
else for (sz = (int) dword_size; sz; sz -= (int) word_size) { else for (sz = (int) dword_size;
sz; sz -= (int) word_size) {
while (size >= sz) { while (size >= sz) {
/* Then copy dwords, words. /* Then copy dwords, words.
Depend on peephole optimizer Depend on peephole optimizer
@ -337,36 +390,28 @@ CodeMove(rhs, left, rtp)
} }
break; break;
} }
if (lhs->dsg_kind == DSG_PLOADED || /* Fall through */
lhs->dsg_kind == DSG_INDEXED) { case DSG_PLOADED:
CodeAddress(lhs); case DSG_PFIXED:
loadedflag = 1; CodeAddress(rhs);
} CodeDesig(left, lhs);
if ((int)(tp->tp_size) % (int) word_size == 0 && CodeAddress(lhs);
tp->tp_align >= word_size) { switch (type_to_stack(tp)) {
CodeAddress(rhs); case USE_BLM:
if (loadedflag) C_exg(pointer_size);
else CodeAddress(lhs);
C_blm(tp->tp_size); C_blm(tp->tp_size);
break; break;
} case USE_LOS_STS:
{ CodeConst(tp->tp_size, (int) pointer_size);
arith tmp; C_bls(pointer_size);
extern arith NewPtr(); break;
case USE_LOAD_STORE:
if (loadedflag) { case USE_LOI_STI:
tmp = NewPtr(); CodeConst(tp->tp_size, (int) pointer_size);
lhs->dsg_offset = tmp; C_cal("_blockmove");
lhs->dsg_name = 0; C_asp(3 * pointer_size);
lhs->dsg_kind = DSG_PFIXED;
lhs->dsg_def = 0;
C_stl(tmp); /* address of lhs */
}
CodeValue(rhs, tp);
CodeStore(lhs, tp);
if (loadedflag) FreePtr(tmp);
break; break;
} }
break;
default: default:
crash("CodeMove"); crash("CodeMove");
} }
@ -397,7 +442,9 @@ CodeAddress(ds)
break; break;
case DSG_PFIXED: case DSG_PFIXED:
DoLoad(ds, word_size); if (! DoLoad(ds, pointer_size)) {
assert(0);
}
break; break;
case DSG_INDEXED: case DSG_INDEXED:
@ -582,14 +629,19 @@ CodeDesig(nd, ds)
df = nd->nd_left->nd_def; df = nd->nd_left->nd_def;
if (proclevel > df->df_scope->sc_level) { if (proclevel > df->df_scope->sc_level) {
C_lxa((arith) (proclevel - df->df_scope->sc_level)); C_lxa((arith) (proclevel - df->df_scope->sc_level));
C_adp(df->var_off + pointer_size); C_adp(df->var_off + pointer_size);
} }
else C_lal(df->var_off + pointer_size); else C_lal(df->var_off + pointer_size);
} }
else { else {
C_loc(nd->nd_left->nd_type->arr_low);
C_sbu(int_size);
c_lae_dlb(nd->nd_left->nd_type->arr_descr); c_lae_dlb(nd->nd_left->nd_type->arr_descr);
} }
if (options['A']) {
C_cal("rcka");
}
ds->dsg_kind = DSG_INDEXED; ds->dsg_kind = DSG_INDEXED;
break; break;

6
lang/m2/comp/em_m2.6
View file

@ -68,6 +68,12 @@ This is useful for interpreters that use the "real" MIN(INTEGER) to
indicate "undefined". indicate "undefined".
.IP \fB-R\fR .IP \fB-R\fR
disable all range checks. disable all range checks.
.IP \fB-A\fR
enable extra array bound checks, for machines that do not implement the
EM ones.
.IP \fB-U\fR
allow for underscores within identifiers. Identifiers may not start with
an underscore, even if this flag is given.
.IP \fB-3\fR .IP \fB-3\fR
only accept Modula-2 programs that strictly conform to [1]. only accept Modula-2 programs that strictly conform to [1].
.LP .LP

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

@ -52,7 +52,9 @@ EnterType(name, type)
"type" in the Current Scope. "type" in the Current Scope.
*/ */
Enter(name, D_TYPE, type, 0); if (! Enter(name, D_TYPE, type, 0)) {
assert(0);
}
} }
EnterEnumList(Idlist, type) EnterEnumList(Idlist, type)
@ -158,7 +160,7 @@ EnterVarList(Idlist, type, local)
df->var_name = df->df_idf->id_text; df->var_name = df->df_idf->id_text;
} }
else { else {
sprint(buf,"%s_%s", sc->sc_scope->sc_name, sprint(buf,"_%s_%s", sc->sc_scope->sc_name,
df->df_idf->id_text); df->df_idf->id_text);
df->var_name = Salloc(buf, df->var_name = Salloc(buf,
(unsigned)(strlen(buf)+1)); (unsigned)(strlen(buf)+1));
@ -473,7 +475,7 @@ node_error(FromId,"identifier \"%s\" does not represent a module",module_name);
module_name); module_name);
df->df_flags |= D_QEXPORTED; df->df_flags |= D_QEXPORTED;
} }
DoImport(df, CurrentScope); if (! DoImport(df, CurrentScope)) assert(0);
} }
if (!forwflag) FreeNode(FromId); if (!forwflag) FreeNode(FromId);
@ -493,10 +495,10 @@ EnterImportList(idlist, local)
f = file_info; f = file_info;
for (; idlist; idlist = idlist->nd_left) { for (; idlist; idlist = idlist->nd_left) {
DoImport(local ? if (! DoImport(local ?
ForwDef(idlist, sc) : ForwDef(idlist, sc) :
GetDefinitionModule(idlist->nd_IDF, 1), GetDefinitionModule(idlist->nd_IDF, 1),
CurrentScope); CurrentScope)) assert(0);
file_info = f; file_info = f;
} }
} }

13
lang/m2/comp/main.c
View file

@ -16,6 +16,7 @@
#include <em_label.h> #include <em_label.h>
#include <em_code.h> #include <em_code.h>
#include <alloc.h> #include <alloc.h>
#include <assert.h>
#include "strict3rd.h" #include "strict3rd.h"
#include "input.h" #include "input.h"
@ -196,7 +197,9 @@ AddStandards()
static t_token nilconst = { INTEGER, 0}; static t_token nilconst = { INTEGER, 0};
for (p = stdproc; p->st_nam != 0; p++) { for (p = stdproc; p->st_nam != 0; p++) {
Enter(p->st_nam, D_PROCEDURE, std_type, p->st_con); if (! Enter(p->st_nam, D_PROCEDURE, std_type, p->st_con)) {
assert(0);
}
} }
EnterType("CHAR", char_type); EnterType("CHAR", char_type);
@ -229,8 +232,12 @@ do_SYSTEM()
EnterType("WORD", word_type); EnterType("WORD", word_type);
EnterType("BYTE", byte_type); EnterType("BYTE", byte_type);
EnterType("ADDRESS",address_type); EnterType("ADDRESS",address_type);
Enter("ADR", D_PROCEDURE, std_type, S_ADR); if (! Enter("ADR", D_PROCEDURE, std_type, S_ADR)) {
Enter("TSIZE", D_PROCEDURE, std_type, S_TSIZE); assert(0);
}
if (! Enter("TSIZE", D_PROCEDURE, std_type, S_TSIZE)) {
assert(0);
}
if (!InsertText(systemtext, sizeof(systemtext) - 1)) { if (!InsertText(systemtext, sizeof(systemtext) - 1)) {
fatal("could not insert text"); fatal("could not insert text");
} }