-static char Version[] = "ACK Modula-2 compiler Version 0.35";
+static char Version[] = "ACK Modula-2 compiler Version 0.36";
#define ChkDesignator(expp) ((*DesigChkTable[(expp)->nd_class])(expp,0))
#define ChkDesig(expp, flags) ((*DesigChkTable[(expp)->nd_class])(expp,flags))
-#define inc_refcount(s) (*((s) - 1) += 1)
-#define dec_refcount(s) (*((s) - 1) -= 1)
-#define refcount(s) (*((s) - 1))
+/* handle reference counts for sets */
+#define inc_refcount(s) (*((int *)(s) - 1) += 1)
+#define dec_refcount(s) (*((int *)(s) - 1) -= 1)
+#define refcount(s) (*((int *)(s) - 1))
CodePExpr(left);
tmp = TmpSpace(left->nd_type->tp_size, left->nd_type->tp_align);
- C_lal(tmp);
- C_sti(WA(left->nd_type->tp_size));
+ STL(tmp, WA(left->nd_type->tp_size));
C_lal(tmp);
}
break;
}
else CodeExpr(leftop, Des, l_maybe, false_label);
def_ilb(l_maybe);
- free_desig(Des);
- Des = new_desig();
+ clear((char *) Des, sizeof(t_desig));
CodeExpr(rightop, Des, true_label, false_label);
if (genlabels) {
def_ilb(true_label);
#include "node.h"
#include "warning.h"
#include "walk.h"
+#include "squeeze.h"
extern int proclevel;
extern arith NewPtr();
return 0;
}
+LOL(offset, size)
+ arith offset, size;
+{
+ if (size == word_size) {
+ C_lol(offset);
+ }
+ else if (size == dword_size) {
+ C_ldl(offset);
+ }
+ else {
+ C_lal(offset);
+ C_loi(size);
+ }
+}
+
+STL(offset, size)
+ arith offset, size;
+{
+ if (size == word_size) {
+ C_stl(offset);
+ }
+ else if (size == dword_size) {
+ C_sdl(offset);
+ }
+ else {
+ C_lal(offset);
+ C_sti(size);
+ }
+}
+
int
DoLoad(ds, size)
register t_desig *ds;
return 1;
}
-int
-word_multiple(tp)
- register t_type *tp;
-{
/* Return 1 if the type indicated by tp has a size that is a
multiple of the word_size and is also word_aligned
*/
- return (int)(tp->tp_size) % (int)word_size == 0 &&
- tp->tp_align >= word_align;
-}
+#define word_multiple(tp) \
+ ( (int)(tp->tp_size) % (int)word_size == 0 && \
+ tp->tp_align >= word_align)
-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 word_dividor(tp) \
+ ( 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
*/
STATIC int
-type_to_stack(tp)
+suitable_move(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
+ - suitable for BLM/LOI/STI
+ - suitable for LOI/STI
+ - suitable for LOS/STS/BLS
+ - suitable for calls to load/store/blockmove
*/
if (! word_multiple(tp)) {
/* Fall through */
case DSG_PLOADED:
case DSG_PFIXED:
- switch (type_to_stack(tp)) {
+ switch (suitable_move(tp)) {
case USE_BLM:
case USE_LOI_STI:
+#ifndef SQUEEZE
CodeAddress(ds);
C_loi(tp->tp_size);
break;
+#endif
case USE_LOS_STS:
CodeAddress(ds);
CodeConst(tp->tp_size, (int)pointer_size);
break;
case USE_LOAD_STORE:
sz = WA(tp->tp_size);
- if (ds->dsg_kind == DSG_PLOADED) {
+ if (ds->dsg_kind != DSG_PFIXED) {
arith tmp = NewPtr();
CodeAddress(ds);
- C_lal(tmp);
- C_sti(pointer_size);
+ STL(tmp, pointer_size);
CodeConst(-sz, (int) pointer_size);
C_ass(pointer_size);
- C_lal(tmp);
- C_loi(pointer_size);
+ LOL(tmp, pointer_size);
FreePtr(tmp);
}
else {
}
ChkForFOR(nd)
- t_node *nd;
+ register t_node *nd;
{
/* Check for an assignment to a FOR-loop control variable
*/
/* Generate code to store the value on the stack in the designator
described in "ds"
*/
- t_desig save;
-
- save = *ds;
switch(ds->dsg_kind) {
case DSG_FIXED:
/* Fall through */
case DSG_PLOADED:
case DSG_PFIXED:
- CodeAddress(&save);
- switch (type_to_stack(tp)) {
+ CodeAddress(ds);
+ switch (suitable_move(tp)) {
case USE_BLM:
case USE_LOI_STI:
+#ifndef SQUEEZE
C_sti(tp->tp_size);
break;
+#endif
case USE_LOS_STS:
CodeConst(tp->tp_size, (int) pointer_size);
C_sts(pointer_size);
*/
register t_desig *lhs = new_desig();
register t_type *tp = left->nd_type;
+ int loadedflag = 0;
ChkForFOR(left);
switch(rhs->dsg_kind) {
CodeStore(lhs, tp);
break;
case DSG_FIXED:
+ CodeDesig(left, lhs);
if (lhs->dsg_kind == DSG_FIXED &&
fit(tp->tp_size, (int) word_size) &&
- (int) (lhs->dsg_offset) % (int) word_size ==
- (int) (rhs->dsg_offset) % (int) word_size) {
- register int sz;
+ (int) (lhs->dsg_offset) % word_align ==
+ (int) (rhs->dsg_offset) % word_align) {
+ register int sz = 1;
arith size = tp->tp_size;
- CodeDesig(left, lhs);
- while (size &&
- (sz = ((int)(lhs->dsg_offset)%(int)word_size))) {
+ while (size && sz < word_align) {
/* First copy up to word-aligned
boundaries
*/
- if (sz < 0) sz = -sz; /* bloody '%' */
- while ((int) word_size % sz) sz--;
- CodeCopy(lhs, rhs, (arith) sz, &size);
- }
- if (size > 3*dword_size) {
- /* Do a block move
- */
- arith sz;
-
- sz = size - size % word_size;
- CodeCopy(lhs, rhs, sz, &size);
- }
- else for (sz = (int) dword_size;
- sz; sz -= (int) word_size) {
- while (size >= sz) {
- /* Then copy dwords, words.
- Depend on peephole optimizer
- */
- CodeCopy(lhs, rhs, (arith) sz, &size);
+ if (!((int)(lhs->dsg_offset)%(sz+sz))) {
+ sz += sz;
}
+ else CodeCopy(lhs, rhs, (arith) sz, &size);
}
+ /* Now copy the bulk
+ */
+ sz = (int) size % (int) word_size;
+ size -= sz;
+ CodeCopy(lhs, rhs, size, &size);
+ size = sz;
sz = word_size;
- while (size && --sz) {
+ while (size) {
/* And then copy remaining parts
*/
- while ((int) word_size % sz) sz--;
- while (size >= sz) {
+ sz >>= 1;
+ if (size >= sz) {
CodeCopy(lhs, rhs, (arith) sz, &size);
}
}
break;
}
+ CodeAddress(lhs);
+ loadedflag = 1;
/* Fall through */
case DSG_PLOADED:
case DSG_PFIXED:
+ assert(! loadedflag || rhs->dsg_kind == DSG_FIXED);
CodeAddress(rhs);
- CodeDesig(left, lhs);
- CodeAddress(lhs);
- switch (type_to_stack(tp)) {
+ if (loadedflag) {
+ C_exg(pointer_size);
+ }
+ else {
+ CodeDesig(left, lhs);
+ CodeAddress(lhs);
+ }
+ switch (suitable_move(tp)) {
case USE_BLM:
+#ifndef SQUEEZE
C_blm(tp->tp_size);
break;
+#endif
case USE_LOS_STS:
CodeConst(tp->tp_size, (int) pointer_size);
C_bls(pointer_size);
int pass_1;
t_def *Defined;
extern int err_occurred;
-extern int Roption;
extern int fp_used; /* set if floating point used */
-static t_node _emptystat = { NULLNODE, NULLNODE, Stat, NULLTYPE, { ';' }};
+static t_node _emptystat = { NULLNODE, NULLNODE, Stat, 0, NULLTYPE, { ';' }};
t_node *EmptyStatement = &_emptystat;
main(argc, argv)
InitScope();
InitTypes();
AddStandards();
- Roption = options['R'];
#ifdef DEBUG
if (options['l']) {
LexScan();
static struct stdproc {
char *st_nam;
int st_con;
-} stdproc[] = {
+} stdprocs[] = {
{ "ABS", S_ABS },
{ "CAP", S_CAP },
{ "CHR", S_CHR },
{ 0, 0 }
};
+static struct stdproc sysprocs[] = {
+ { "TSIZE", S_TSIZE },
+ { "ADR", S_ADR },
+ { 0, 0 }
+};
+
extern t_def *Enter();
-AddStandards()
-{
- register t_def *df;
+AddProcs(p)
register struct stdproc *p;
- static t_token nilconst = { INTEGER, 0};
-
- for (p = stdproc; p->st_nam != 0; p++) {
+{
+ for (; p->st_nam != 0; p++) {
if (! Enter(p->st_nam, D_PROCEDURE, std_type, p->st_con)) {
assert(0);
}
}
+}
+
+AddStandards()
+{
+ register t_def *df;
+ static t_token nilconst = { INTEGER, 0};
+ AddProcs(stdprocs);
EnterType("CHAR", char_type);
EnterType("INTEGER", int_type);
EnterType("LONGINT", longint_type);
EnterType("WORD", word_type);
EnterType("BYTE", byte_type);
EnterType("ADDRESS",address_type);
- if (! Enter("ADR", D_PROCEDURE, std_type, S_ADR)) {
- assert(0);
- }
- if (! Enter("TSIZE", D_PROCEDURE, std_type, S_TSIZE)) {
- assert(0);
- }
+ AddProcs(sysprocs);
if (!InsertText(systemtext, sizeof(systemtext) - 1)) {
fatal("could not insert text");
}
struct node {
struct node *nd_left;
struct node *nd_right;
- int nd_class; /* kind of node */
+ char nd_class; /* kind of node */
#define Value 0 /* constant */
#define Arrsel 1 /* array selection */
#define Oper 2 /* binary operator */
#define Def 9 /* an identified name */
#define Stat 10 /* a statement */
#define Link 11
-#define Option 12
/* do NOT change the order or the numbers!!! */
+ char nd_flags; /* options */
+#define ROPTION 1
+#define AOPTION 2
struct type *nd_type; /* type of this node */
struct token nd_token;
#define nd_set nd_token.tk_data.tk_set
#include "def.h"
#include "type.h"
#include "node.h"
+#include "main.h"
t_node *
MkNode(class, left, right, token)
nd->nd_right = right;
nd->nd_token = *token;
nd->nd_class = class;
+ if (options['R']) nd->nd_flags |= ROPTION;
+ if (options['A']) nd->nd_flags |= AOPTION;
return nd;
}
MkLeaf(class, token)
t_token *token;
{
- register t_node *nd = new_node();
-
- nd->nd_token = *token;
- nd->nd_class = class;
- return nd;
+ return MkNode(class, NULLNODE, NULLNODE, token);
}
t_node *
dot2leaf(class)
{
- return MkLeaf(class, &dot);
+ return MkNode(class, NULLNODE, NULLNODE, &dot);
}
FreeLR(nd)
sc->sc_level = proclevel;
ls->sc_scope = sc;
ls->sc_encl = CurrVis;
- if (scopetype == OPENSCOPE) {
+ if (! sc->sc_scopeclosed) {
ls->sc_next = ls->sc_encl;
}
CurrVis = ls;
register t_scope *sc = new_scope();
register t_scopelist *ls = new_scopelist();
- sc->sc_scopeclosed = 0;
- sc->sc_def = 0;
sc->sc_level = proclevel;
PervasiveScope = sc;
- ls->sc_next = 0;
- ls->sc_encl = 0;
ls->sc_scope = PervasiveScope;
PervVis = ls;
CurrVis = ls;
#include "node.h"
static int loopcount = 0; /* Count nested loops */
-int Roption;
-extern char options[];
extern t_node *EmptyStatement;
}
register t_node *nd;
extern int return_occurred;
} :
- /* We need some method for making sure lookahead is done, so ...
- */
- [ PROGRAM
- /* LLlex never returns this */
- | %default
- { if (options['R'] != Roption) {
- Roption = options['R'];
- nd = dot2leaf(Option);
- nd->nd_symb = 'R';
- nd->nd_INT = Roption;
- *pnd = nd =
- dot2node(Link, nd, NULLNODE);
- nd->nd_symb = ';';
- pnd = &(nd->nd_right);
- }
- }
- ]
-[
/*
* This part is not in the reference grammar. The reference grammar
* states : assignment | ProcedureCall | ...
{ return_occurred = 1; }
|
/* empty */ { *pnd = EmptyStatement; }
-]
;
/*
extern long max_int[];
extern long min_int[];
-#define fit(n, i) (((n) + ((arith)0x80<<(((i)-1)*8)) & ~full_mask[(i)]) == 0)
#define ufit(n, i) (((n) & ~full_mask[(i)]) == 0)
*error_type = *char_type;
}
+int
+fit(sz, nbytes)
+ arith sz;
+{
+ return ((sz) + ((arith)0x80<<(((nbytes)-1)*8)) & ~full_mask[(nbytes)]) == 0;
+}
+
STATIC
u_small(tp, n)
register t_type *tp;
if (tp->tp_size < word_size &&
(int) word_size % (int) tp->tp_size == 0) {
C_lol(param->par_def->var_off);
- C_lal(param->par_def->var_off);
- C_sti(tp->tp_size);
+ STL(param->par_def->var_off, tp->tp_size);
}
}
else {
}
StackAdjustment = NewPtr();
C_lor((arith) 1);
- C_lal(StackAdjustment);
- C_sti(pointer_size);
+ STL(StackAdjustment, pointer_size);
}
/* First compute new stackpointer */
C_lal(param->par_def->var_off);
C_lfr(pointer_size);
C_str((arith) 1);
/* adjusted stack pointer */
- C_lal(param->par_def->var_off);
- C_loi(pointer_size);
+ LOL(param->par_def->var_off, pointer_size);
/* push source address */
C_cal("_copy_array");
/* copy */
if (StackAdjustment) {
/* Remove copies of conformant arrays
*/
- C_lal(StackAdjustment);
- C_loi(pointer_size);
+ LOL(StackAdjustment, pointer_size);
C_str((arith) 1);
}
c_lae_dlb(func_res_label);
and put function result back on the stack
*/
if (func_type) {
- C_lal(retsav);
- C_sti(func_res_size);
+ STL(retsav, func_res_size);
}
- C_lal(StackAdjustment);
- C_loi(pointer_size);
+ LOL(StackAdjustment, pointer_size);
C_str((arith) 1);
if (func_type) {
- C_lal(retsav);
- C_loi(func_res_size);
+ LOL(retsav, func_res_size);
}
- FreePtr(StackAdjustment);
}
EndPriority();
C_ret(func_res_size);
assert(nd->nd_class == Stat);
DoLineno(nd);
+ if (nd->nd_flags & ROPTION) options['R'] = 1;
+ if (nd->nd_flags & AOPTION) options['A'] = 1;
switch(nd->nd_symb) {
case '(':
if (ChkCall(nd)) {
extern int NodeCrash();
-STATIC
-WalkOption(nd)
- t_node *nd;
-{
- /* Set option indicated by node "nd"
- */
-
- options[nd->nd_symb] = nd->nd_INT;
-}
-
int (*WalkTable[])() = {
NodeCrash,
NodeCrash,
NodeCrash,
WalkStat,
WalkLink,
- WalkOption
};
ExpectBool(nd, true_label, false_label)
UseWarnings(df)
register t_def *df;
{
- if (is_anon_idf(df->df_idf)) return;
- if (df->df_kind & (D_IMPORTED | D_VARIABLE | D_PROCEDURE | D_CONST | D_TYPE)) {
- struct node *nd;
-
- if (df->df_flags & (D_EXPORTED | D_QEXPORTED)) return;
- if (df->df_kind & D_IMPORTED) {
- register t_def *df1 = df->imp_def;
-
- df1->df_flags |= df->df_flags & (D_USED|D_DEFINED);
- if (df->df_kind == D_INUSE) return;
- if ( !(df->df_flags & D_IMP_BY_EXP)) {
- if (! (df->df_flags & (D_USED | D_DEFINED))) {
- node_warning(
- df->df_scope->sc_end,
- W_ORDINARY,
- "identifier \"%s\" imported but not %s",
- df->df_idf->id_text,
- df1->df_kind == D_VARIABLE ?
- "used/assigned" :
- "used");
+ char *warning = 0;
+
+ if (is_anon_idf(df->df_idf) ||
+ !(df->df_kind&(D_IMPORTED|D_VARIABLE|D_PROCEDURE|D_CONST|D_TYPE)) ||
+ (df->df_flags&(D_EXPORTED|D_QEXPORTED))) {
+ return;
+ }
+
+ if (df->df_kind & D_IMPORTED) {
+ register t_def *df1 = df->imp_def;
+
+ df1->df_flags |= df->df_flags & (D_USED|D_DEFINED);
+ if (df->df_kind == D_INUSE) return;
+ if ( !(df->df_flags & D_IMP_BY_EXP)) {
+ if (! (df->df_flags & (D_USED | D_DEFINED))) {
+ if (df1->df_kind == D_VARIABLE) {
+ warning = "imported but not used/assigned";
}
- return;
+ else warning = "imported but not used";
+ goto warn;
}
- df = df1;
- }
- if (! (df->df_kind & (D_VARIABLE|D_PROCEDURE|D_TYPE|D_CONST))) return;
- nd = df->df_scope->sc_end;
- if (! (df->df_flags & D_DEFINED)) {
- node_warning(nd,
- W_ORDINARY,
- "identifier \"%s\" never assigned",
- df->df_idf->id_text);
- }
- if (! (df->df_flags & D_USED)) {
- node_warning(nd,
- W_ORDINARY,
- "identifier \"%s\" never used",
- df->df_idf->id_text);
+ return;
}
+ df = df1;
+ }
+ if (! (df->df_kind & (D_VARIABLE|D_PROCEDURE|D_TYPE|D_CONST))) {
+ return;
+ }
+ switch(df->df_flags & (D_USED|D_DEFINED)) {
+ case 0:
+ warning = "never used/assigned";
+ break;
+ case D_USED:
+ warning = "never assigned";
+ break;
+ case D_DEFINED:
+ warning = "never used";
+ break;
+ case D_USED|D_DEFINED:
+ return;
+ }
+warn:
+ if (warning) {
+ node_warning(df->df_scope->sc_end,
+ W_ORDINARY,
+ "identifier \"%s\" %s",
+ df->df_idf->id_text, warning);
}
}
public / ack.git / commitdiff