From e71df150452cd522c8ec4d0fa6e55a3638f8c91a Mon Sep 17 00:00:00 2001 From: ceriel Date: Tue, 22 Mar 1988 17:54:01 +0000 Subject: [PATCH] made to fit on PDP-11 again --- lang/m2/comp/Version.c | 2 +- lang/m2/comp/chk_expr.h | 7 +- lang/m2/comp/code.c | 6 +- lang/m2/comp/desig.c | 149 ++++++++++++++++++++++----------------- lang/m2/comp/main.c | 35 ++++----- lang/m2/comp/node.H | 6 +- lang/m2/comp/node.c | 11 ++- lang/m2/comp/scope.C | 6 +- lang/m2/comp/statement.g | 21 ------ lang/m2/comp/type.H | 1 - lang/m2/comp/type.c | 7 ++ lang/m2/comp/walk.c | 115 ++++++++++++++---------------- 12 files changed, 182 insertions(+), 184 deletions(-) diff --git a/lang/m2/comp/Version.c b/lang/m2/comp/Version.c index adcaf8e81..e1b1e8c3e 100644 --- a/lang/m2/comp/Version.c +++ b/lang/m2/comp/Version.c @@ -1 +1 @@ -static char Version[] = "ACK Modula-2 compiler Version 0.35"; +static char Version[] = "ACK Modula-2 compiler Version 0.36"; diff --git a/lang/m2/comp/chk_expr.h b/lang/m2/comp/chk_expr.h index 8de1bbeca..519f9ee4a 100644 --- a/lang/m2/comp/chk_expr.h +++ b/lang/m2/comp/chk_expr.h @@ -20,6 +20,7 @@ extern int (*DesigChkTable[])(); /* table of designator checking #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)) diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c index 1c85e5a9a..484cdfa1b 100644 --- a/lang/m2/comp/code.c +++ b/lang/m2/comp/code.c @@ -429,8 +429,7 @@ CodeParameters(param, arg) 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; @@ -892,8 +891,7 @@ CodeOper(expr, true_label, false_label) } 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); diff --git a/lang/m2/comp/desig.c b/lang/m2/comp/desig.c index e364f47a5..958c14bf4 100644 --- a/lang/m2/comp/desig.c +++ b/lang/m2/comp/desig.c @@ -32,6 +32,7 @@ #include "node.h" #include "warning.h" #include "walk.h" +#include "squeeze.h" extern int proclevel; extern arith NewPtr(); @@ -52,6 +53,36 @@ WordOrDouble(ds, size) 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; @@ -106,30 +137,22 @@ DoStore(ds, size) 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 @@ -139,14 +162,15 @@ word_dividor(tp) */ 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)) { @@ -175,12 +199,14 @@ CodeValue(ds, 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); @@ -188,16 +214,14 @@ CodeValue(ds, tp) 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 { @@ -224,7 +248,7 @@ CodeValue(ds, tp) } ChkForFOR(nd) - t_node *nd; + register t_node *nd; { /* Check for an assignment to a FOR-loop control variable */ @@ -248,9 +272,6 @@ CodeStore(ds, tp) /* 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: @@ -258,12 +279,14 @@ CodeStore(ds, tp) /* 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); @@ -326,6 +349,7 @@ CodeMove(rhs, left, rtp) */ register t_desig *lhs = new_desig(); register t_type *tp = left->nd_type; + int loadedflag = 0; ChkForFOR(left); switch(rhs->dsg_kind) { @@ -345,61 +369,60 @@ CodeMove(rhs, left, rtp) 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); diff --git a/lang/m2/comp/main.c b/lang/m2/comp/main.c index ff871471d..d09901f63 100644 --- a/lang/m2/comp/main.c +++ b/lang/m2/comp/main.c @@ -42,9 +42,8 @@ int nDEF, mDEF; 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) @@ -92,7 +91,6 @@ Compile(src, dst) InitScope(); InitTypes(); AddStandards(); - Roption = options['R']; #ifdef DEBUG if (options['l']) { LexScan(); @@ -159,7 +157,7 @@ LexScan() static struct stdproc { char *st_nam; int st_con; -} stdproc[] = { +} stdprocs[] = { { "ABS", S_ABS }, { "CAP", S_CAP }, { "CHR", S_CHR }, @@ -188,20 +186,30 @@ static struct stdproc { { 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); @@ -232,12 +240,7 @@ do_SYSTEM() 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"); } diff --git a/lang/m2/comp/node.H b/lang/m2/comp/node.H index a18ccc631..b4b476f66 100644 --- a/lang/m2/comp/node.H +++ b/lang/m2/comp/node.H @@ -12,7 +12,7 @@ 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 */ @@ -25,8 +25,10 @@ struct node { #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 diff --git a/lang/m2/comp/node.c b/lang/m2/comp/node.c index 55f9f64b1..64b654428 100644 --- a/lang/m2/comp/node.c +++ b/lang/m2/comp/node.c @@ -20,6 +20,7 @@ #include "def.h" #include "type.h" #include "node.h" +#include "main.h" t_node * MkNode(class, left, right, token) @@ -34,6 +35,8 @@ 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; } @@ -48,17 +51,13 @@ t_node * 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) diff --git a/lang/m2/comp/scope.C b/lang/m2/comp/scope.C index 1ebc91175..4a3eb82d2 100644 --- a/lang/m2/comp/scope.C +++ b/lang/m2/comp/scope.C @@ -46,7 +46,7 @@ open_scope(scopetype) 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; @@ -68,12 +68,8 @@ InitScope() 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; diff --git a/lang/m2/comp/statement.g b/lang/m2/comp/statement.g index 8973c1437..0e43d9ee8 100644 --- a/lang/m2/comp/statement.g +++ b/lang/m2/comp/statement.g @@ -22,8 +22,6 @@ #include "node.h" static int loopcount = 0; /* Count nested loops */ -int Roption; -extern char options[]; extern t_node *EmptyStatement; } @@ -32,24 +30,6 @@ statement(register t_node **pnd;) 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 | ... @@ -108,7 +88,6 @@ statement(register t_node **pnd;) { return_occurred = 1; } | /* empty */ { *pnd = EmptyStatement; } -] ; /* diff --git a/lang/m2/comp/type.H b/lang/m2/comp/type.H index fe9a04fe4..4ff1930d3 100644 --- a/lang/m2/comp/type.H +++ b/lang/m2/comp/type.H @@ -220,5 +220,4 @@ extern long full_mask[]; 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) diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c index bbaca8fee..246a9a880 100644 --- a/lang/m2/comp/type.c +++ b/lang/m2/comp/type.c @@ -210,6 +210,13 @@ InitTypes() *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; diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c index c3120ad87..7e9be7d86 100644 --- a/lang/m2/comp/walk.c +++ b/lang/m2/comp/walk.c @@ -268,8 +268,7 @@ WalkProcedure(procedure) 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 { @@ -297,8 +296,7 @@ WalkProcedure(procedure) } 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); @@ -307,8 +305,7 @@ WalkProcedure(procedure) 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 */ @@ -336,8 +333,7 @@ WalkProcedure(procedure) 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); @@ -349,17 +345,13 @@ WalkProcedure(procedure) 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); @@ -453,6 +445,8 @@ WalkStat(nd, exit_label) 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)) { @@ -682,16 +676,6 @@ WalkStat(nd, exit_label) 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, @@ -705,7 +689,6 @@ int (*WalkTable[])() = { NodeCrash, WalkStat, WalkLink, - WalkOption }; ExpectBool(nd, true_label, false_label) @@ -883,45 +866,53 @@ static int 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); } } -- 2.34.1