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

many minor mods

Browse source
This commit is contained in:
ceriel 1988-03-23 17:44:25 +00:00
parent 9dce6c6b88
commit 7f9fd963fd
13 changed files with 92 additions and 69 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
lang/m2/comp/LLlex.c
View file

@ -354,7 +354,10 @@ again:
if (ch == EOI) eofseen = 1;
else PushBack();
*tag++ = '\0';
*tag = '\0';
if (*(tag - 1) == '_') {
lexerror("last character of an identifier may not be a '_'");
}
tk->TOK_IDF = id = str2idf(buf, 1);
return tk->tk_symb = id->id_reserved ? id->id_reserved : IDENT;

1
lang/m2/comp/Makefile
View file

@ -292,6 +292,7 @@ node.o: LLlex.h
node.o: debug.h
node.o: debugcst.h
node.o: def.h
node.o: main.h
node.o: nocross.h
node.o: node.h
node.o: target_sizes.h

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

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

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

@ -1407,7 +1407,6 @@ int (*ExprChkTable[])() = {
done_before,
NodeCrash,
ChkExLinkOrName,
NodeCrash
};
int (*DesigChkTable[])() = {
@ -1423,5 +1422,4 @@ int (*DesigChkTable[])() = {
done_before,
NodeCrash,
ChkLinkOrName,
NodeCrash
};

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

@ -359,7 +359,8 @@ CodeCall(nd)
}
else C_lfr(sz);
}
DoFilename(nd);
DoFilename();
DoLineno(nd);
}
CodeParameters(param, arg)
@ -503,12 +504,12 @@ CodeStd(nd)
case S_ABS:
CodePExpr(left);
if (tp->tp_fund == T_INTEGER) {
if (tp->tp_size == int_size) C_cal("_absi");
else C_cal("_absl");
if (tp->tp_size == int_size) C_cal("absi");
else C_cal("absl");
}
else if (tp->tp_fund == T_REAL) {
if (tp->tp_size == float_size) C_cal("_absf");
else C_cal("_absd");
if (tp->tp_size == float_size) C_cal("absf");
else C_cal("absd");
}
C_asp(tp->tp_size);
C_lfr(tp->tp_size);
@ -585,7 +586,7 @@ CodeStd(nd)
}
case S_HALT:
C_cal("_halt");
C_cal("halt");
break;
case S_INCL:
@ -1026,7 +1027,7 @@ CodeEl(nd, tp)
}
else C_loc((arith) (eltype->enm_ncst - 1));
Operands(nd);
C_cal("_LtoUset"); /* library routine to fill set */
C_cal("LtoUset"); /* library routine to fill set */
C_asp(5 * word_size);
}
else {
@ -1060,7 +1061,9 @@ CodeDAddress(nd)
register t_desig *designator = new_desig();
ChkForFOR(nd);
/* ChkForFOR(nd); ??? not quite: wrong for value conformant arrays,
where the parameter is the for-loop control variable
*/
CodeDesig(nd, designator);
CodeAddress(designator);
free_desig(designator);

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

@ -27,6 +27,16 @@
#include "Lpars.h"
#include "warning.h"
STATIC
internal(c)
register char *c;
{
if (options['x']) {
C_exp(c);
}
else C_inp(c);
}
STATIC
DefInFront(df)
register t_def *df;
@ -256,7 +266,7 @@ DeclProc(type, id)
df->for_name = id->id_text;
}
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));
}
if (CurrVis == Defined->mod_vis) {
@ -281,10 +291,7 @@ DeclProc(type, id)
df = define(id, CurrentScope, type);
sprint(buf,"_%d_%s",++nmcount,id->id_text);
name = Salloc(buf, (unsigned)(strlen(buf)+1));
if (options['x']) {
C_exp(buf);
}
else C_inp(buf);
internal(buf);
df->df_flags |= D_DEFINED;
}
open_scope(OPENSCOPE);
@ -330,7 +337,7 @@ DefineLocalModule(id)
extern char *sprint();
extern int proclevel;
sprint(buf, "_%d%s", ++modulecount, id->id_text);
sprint(buf, "_%d%s_", ++modulecount, id->id_text);
if (!df->mod_vis) {
/* We never saw the name of this module before. Create a
@ -355,11 +362,7 @@ DefineLocalModule(id)
/* Generate code that indicates that the initialization procedure
for this module is local.
*/
if (options['x']) {
C_exp(buf);
}
else C_inp(buf);
internal(buf);
return df;
}

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

@ -128,9 +128,8 @@ GetDefinitionModule(id, incr)
register t_node *n;
extern t_node *Modules;
n = dot2leaf(Name);
n->nd_IDF = id;
n->nd_symb = IDENT;
n = dot2leaf(Def);
n->nd_def = CurrentScope->sc_definedby;
if (nd_end) nd_end->nd_left = n;
else Modules = n;
nd_end = n;

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

@ -214,7 +214,10 @@ CodeValue(ds, tp)
break;
case USE_LOAD_STORE:
sz = WA(tp->tp_size);
if (ds->dsg_kind != DSG_PFIXED) {
#ifndef SQUEEZE
if (ds->dsg_kind != DSG_PFIXED)
#endif
{
arith tmp = NewPtr();
CodeAddress(ds);
@ -224,13 +227,15 @@ CodeValue(ds, tp)
LOL(tmp, pointer_size);
FreePtr(tmp);
}
#ifndef SQUEEZE
else {
CodeConst(-sz, (int) pointer_size);
C_ass(pointer_size);
}
#endif
CodeAddress(ds);
CodeConst(tp->tp_size, (int) pointer_size);
C_cal("_load");
C_cal("load");
C_asp(pointer_size + pointer_size);
break;
}
@ -293,7 +298,7 @@ CodeStore(ds, tp)
break;
case USE_LOAD_STORE:
CodeConst(tp->tp_size, (int) pointer_size);
C_cal("_store");
C_cal("store");
CodeConst(pointer_size + pointer_size + WA(tp->tp_size),
(int) pointer_size);
C_ass(pointer_size);
@ -362,7 +367,7 @@ CodeMove(rhs, left, rtp)
CodeAddress(lhs);
C_loc(rtp->tp_size);
C_loc(tp->tp_size);
C_cal("_StringAssign");
C_cal("StringAssign");
C_asp(pointer_size + pointer_size + dword_size);
break;
}
@ -430,7 +435,7 @@ CodeMove(rhs, left, rtp)
case USE_LOAD_STORE:
case USE_LOI_STI:
CodeConst(tp->tp_size, (int) pointer_size);
C_cal("_blockmove");
C_cal("blockmove");
C_asp(3 * pointer_size);
break;
}
@ -543,6 +548,7 @@ CodeVarDesig(df, ds)
those of an enclosing procedure, or it is global.
*/
register t_scope *sc = df->df_scope;
int difflevel;
/* Selections from a module are handled earlier, when identifying
the variable, so ...
@ -569,16 +575,16 @@ CodeVarDesig(df, ds)
return;
}
if (sc->sc_level != proclevel) {
if ((difflevel = proclevel - sc->sc_level) != 0) {
/* the variable is local to a statically enclosing procedure.
*/
assert(proclevel > sc->sc_level);
assert(difflevel > 0);
df->df_flags |= D_NOREG;
if (df->df_flags & (D_VARPAR|D_VALPAR)) {
/* value or var parameter
*/
C_lxa((arith) (proclevel - sc->sc_level));
C_lxa((arith) difflevel);
if ((df->df_flags & D_VARPAR) ||
IsConformantArray(df->df_type)) {
/* var parameter or conformant array.
@ -592,7 +598,7 @@ CodeVarDesig(df, ds)
return;
}
}
else C_lxl((arith) (proclevel - sc->sc_level));
else C_lxl((arith) difflevel);
ds->dsg_kind = DSG_PLOADED;
ds->dsg_offset = df->var_off;
return;
@ -644,23 +650,26 @@ CodeDesig(nd, ds)
CodeDesig(nd->nd_left, ds);
CodeAddress(ds);
CodePExpr(nd->nd_right);
nd = nd->nd_left;
/* Now load address of descriptor
*/
if (IsConformantArray(nd->nd_left->nd_type)) {
assert(nd->nd_left->nd_class == Def);
if (IsConformantArray(nd->nd_type)) {
arith off;
assert(nd->nd_class == Def);
df = nd->nd_left->nd_def;
df = nd->nd_def;
off = df->var_off + pointer_size;
if (proclevel > df->df_scope->sc_level) {
C_lxa((arith) (proclevel - df->df_scope->sc_level));
C_adp(df->var_off + pointer_size);
C_adp(off);
}
else C_lal(df->var_off + pointer_size);
else C_lal(off);
}
else {
C_loc(nd->nd_left->nd_type->arr_low);
C_loc(nd->nd_type->arr_low);
C_sbu(int_size);
c_lae_dlb(nd->nd_left->nd_type->arr_descr);
c_lae_dlb(nd->nd_type->arr_descr);
}
if (options['A']) {
C_cal("rcka");
@ -671,7 +680,8 @@ CodeDesig(nd, ds)
case Arrow:
assert(nd->nd_symb == '^');
CodeDesig(nd->nd_right, ds);
nd = nd->nd_right;
CodeDesig(nd, ds);
switch(ds->dsg_kind) {
case DSG_LOADED:
ds->dsg_kind = DSG_PLOADED;
@ -680,7 +690,7 @@ CodeDesig(nd, ds)
case DSG_INDEXED:
case DSG_PLOADED:
case DSG_PFIXED:
CodeValue(ds, nd->nd_right->nd_type);
CodeValue(ds, nd->nd_type);
ds->dsg_kind = DSG_PLOADED;
ds->dsg_offset = 0;
break;

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

@ -160,7 +160,7 @@ EnterVarList(Idlist, type, local)
df->var_name = df->df_idf->id_text;
}
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->var_name = Salloc(buf,
(unsigned)(strlen(buf)+1));

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

@ -128,7 +128,9 @@ DefinitionModule
int dummy;
extern t_idf *DefId;
extern int ForeignFlag;
extern char *sprint();
register t_scope *currscope = CurrentScope;
char buf[512];
} :
DEFINITION
MODULE IDENT { df = define(dot.TOK_IDF, GlobalScope, D_MODULE);
@ -139,7 +141,8 @@ DefinitionModule
error("DEFINITION MODULE name is \"%s\", not \"%s\"",
df->df_idf->id_text, DefId->id_text);
}
currscope->sc_name = df->df_idf->id_text;
sprint(buf, "_%s_", df->df_idf->id_text);
currscope->sc_name = Salloc(buf, (unsigned) strlen(buf) + 1);
df->mod_vis = CurrVis;
df->df_type = standard_type(T_RECORD, 1, (arith) 1);
df->df_type->rec_scope = currscope;
@ -214,7 +217,7 @@ ProgramModule
Defined = df = define(dot.TOK_IDF, GlobalScope, D_MODULE);
open_scope(CLOSEDSCOPE);
df->mod_vis = CurrVis;
CurrentScope->sc_name = "_M2M";
CurrentScope->sc_name = "__M2M_";
CurrentScope->sc_definedby = df;
}
}

2
lang/m2/comp/tmpvar.C
View file

@ -63,7 +63,7 @@ TmpSpace(sz, al)
STATIC arith
NewTmp(plist, sz, al, regtype)
struct tmpvar **plist;
register struct tmpvar **plist;
arith sz;
{
register arith offset;

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

@ -263,7 +263,7 @@ TstParCompat(parno, formaltype, VARflag, nd, edf)
}
CompatCheck(nd, tp, message, fc)
t_node **nd;
register t_node **nd;
t_type *tp;
char *message;
int (*fc)();

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

@ -74,18 +74,21 @@ LblWalkNode(lbl, nd, exit)
WalkNode(nd, exit);
}
static arith tmpprio;
STATIC
DoPriority()
{
/* For the time being (???), handle priorities by calls to
the runtime system
*/
register t_node *pri = priority;
if (pri) {
C_loc(pri->nd_INT);
C_cal("_stackprio");
if (priority) {
tmpprio = NewInt();
C_loc(priority->nd_INT);
C_cal("stackprio");
C_asp(word_size);
C_lfr(word_size);
C_stl(tmpprio);
}
}
@ -93,7 +96,10 @@ STATIC
EndPriority()
{
if (priority) {
C_cal("_unstackprio");
C_lol(tmpprio);
C_cal("unstackprio");
C_asp(word_size);
FreeInt(tmpprio);
}
}
@ -113,8 +119,7 @@ DoLineno(nd)
}
}
DoFilename(nd)
t_node *nd;
DoFilename()
{
static label filename_label = 0;
@ -128,8 +133,6 @@ DoFilename(nd)
}
C_fil_dlb((label) 1, (arith) 0);
if (nd) DoLineno(nd);
}
}
@ -160,7 +163,6 @@ WalkModule(module)
TmpOpen(sc); /* Initialize for temporaries */
C_pro_narg(sc->sc_name);
DoPriority();
DoFilename(module->mod_body);
if (module == Defined) {
/* Body of implementation or program module.
Call initialization routines of imported modules.
@ -183,8 +185,9 @@ WalkModule(module)
}
for (; nd; nd = nd->nd_left) {
C_cal(nd->nd_IDF->id_text);
C_cal(nd->nd_def->mod_vis->sc_scope->sc_name);
}
DoFilename();
}
WalkDefList(sc->sc_def, MkCalls);
proclevel++;
@ -227,7 +230,7 @@ WalkProcedure(procedure)
*/
C_pro_narg(procscope->sc_name);
DoPriority();
DoFilename(procedure->prc_body);
DoFilename(); /* ??? only when this procedure is exported? */
TmpOpen(procscope);
func_type = tp = RemoveEqual(ResultType(procedure->df_type));
@ -300,14 +303,14 @@ WalkProcedure(procedure)
}
/* First compute new stackpointer */
C_lal(param->par_def->var_off);
C_cal("_new_stackptr");
C_cal("new_stackptr");
C_asp(pointer_size);
C_lfr(pointer_size);
C_str((arith) 1);
/* adjusted stack pointer */
LOL(param->par_def->var_off, pointer_size);
/* push source address */
C_cal("_copy_array");
C_cal("copy_array");
/* copy */
C_asp(pointer_size);
}
@ -445,13 +448,13 @@ 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;
options['R'] = (nd->nd_flags & ROPTION);
options['A'] = (nd->nd_flags & AOPTION);
switch(nd->nd_symb) {
case '(':
if (ChkCall(nd)) {
if (nd->nd_type != 0) {
node_error(nd, "illegal function call");
node_error(nd, "procedure call expected instead of function call");
break;
}
CodeCall(nd);
@ -521,7 +524,7 @@ WalkStat(nd, exit_label)
case FOR:
{
arith tmp = NewInt();
arith tmp2;
arith tmp2 = 0;
register t_node *fnd;
int good_forvar;
label l1 = ++text_label;
@ -575,7 +578,7 @@ WalkStat(nd, exit_label)
WalkNode(right, exit_label);
nd->nd_def->df_flags &= ~D_FORLOOP;
if (good_forvar) {
if (! options['R']) {
if (tmp2 != 0) {
label x = ++text_label;
C_lol(tmp2);
ForLoopVarExpr(nd);