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

newer version

Browse source
This commit is contained in:
ceriel 1986-06-06 02:22:09 +00:00
parent db258b68ea
commit caf99ea472
17 changed files with 224 additions and 301 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -29,7 +29,6 @@ struct token dot, aside;
struct type *toktype;
struct string string;
int idfsize = IDFSIZE;
extern label data_label();
static
SkipComment()
@ -51,21 +50,15 @@ SkipComment()
if (ch == '*') {
++NestLevel;
}
else {
continue;
}
else continue;
}
else
if (ch == '*') {
LoadChar(ch);
if (ch == ')') {
if (NestLevel-- == 0) {
return;
}
}
else {
continue;
if (NestLevel-- == 0) return;
}
else continue;
}
LoadChar(ch);
}
@ -198,7 +191,7 @@ again:
return tk->tk_symb = ch;
default :
assert(0);
crash("(LLlex, STCOMP)");
}
case STIDF:
@ -216,7 +209,6 @@ again:
*tg++ = '\0';
tk->TOK_IDF = id = str2idf(buf, 1);
if (!id) fatal("Out of memory");
return tk->tk_symb = id->id_reserved ? id->id_reserved : IDENT;
}
@ -413,7 +405,7 @@ Sdec:
case STCHAR:
default:
assert(0);
crash("(LLlex) Impossible character class");
}
/*NOTREACHED*/
}

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

@ -68,15 +68,34 @@ chk_expr(expp)
case Xset:
return chk_set(expp);
case Link:
case Name:
return chk_designator(expp, VALUE, D_USED);
if (chk_designator(expp, VALUE|DESIGNATOR, D_USED)) {
if (expp->nd_class == Def &&
expp->nd_def->df_kind == D_PROCEDURE) {
/* Check that this procedure is one that we
may take the address from.
*/
if (expp->nd_def->df_type == std_type) {
/* Standard procedure. Illegal */
node_error(expp, "address of standard procedure taken");
return 0;
}
if (expp->nd_def->df_scope->sc_level > 0) {
/* Address of nested procedure taken.
Illegal.
*/
node_error(expp, "address of a procedure local to another one taken");
return 0;
}
}
return 1;
}
return 0;
case Call:
return chk_call(expp);
case Link:
return chk_designator(expp, DESIGNATOR|VALUE, D_USED|D_NOREG);
default:
crash("(chk_expr)");
}
@ -312,7 +331,6 @@ chk_call(expp)
it may also be a cast or a standard procedure call.
*/
register struct node *left;
register struct node *arg;
/* First, get the name of the function or procedure
*/
@ -340,7 +358,8 @@ chk_call(expp)
*/
return chk_proccall(expp);
}
node_error(expp->nd_left, "procedure, type, or function expected");
node_error(left, "procedure, type, or function expected");
return 0;
}
@ -420,7 +439,7 @@ FlagCheck(expp, df, flag)
}
if ((flag & VALUE) &&
( !(df->df_kind & (D_VARIABLE|D_FIELD|D_CONST|D_ENUM)))) {
( !(df->df_kind & (D_VARIABLE|D_FIELD|D_CONST|D_ENUM|D_PROCEDURE)))) {
node_error(expp, "value expected");
return 0;
}
@ -584,6 +603,62 @@ symbol2str(expp->nd_symb));
return 0;
}
struct type *
ResultOfOperation(operator, tp)
struct type *tp;
{
switch(operator) {
case '=':
case '#':
case GREATEREQUAL:
case LESSEQUAL:
case '<':
case '>':
case IN:
return bool_type;
}
return tp;
}
int
Boolean(operator)
{
return operator == OR || operator == AND || operator == '&';
}
int
AllowedTypes(operator)
{
switch(operator) {
case '+':
case '-':
case '*':
return T_NUMERIC|T_SET;
case '/':
return T_REAL|T_SET;
case DIV:
case MOD:
return T_INTORCARD;
case OR:
case AND:
case '&':
return T_ENUMERATION;
case '=':
case '#':
return T_POINTER|T_HIDDEN|T_SET|T_NUMERIC|T_ENUMERATION|T_CHAR;
case GREATEREQUAL:
case LESSEQUAL:
return T_SET|T_NUMERIC|T_CHAR|T_ENUMERATION;
case '<':
case '>':
return T_NUMERIC|T_CHAR|T_ENUMERATION;
default:
crash("(AllowedTypes)");
}
/*NOTREACHED*/
}
int
chk_oper(expp)
register struct node *expp;
@ -594,8 +669,11 @@ chk_oper(expp)
register struct node *right = expp->nd_right;
struct type *tpl = left->nd_type;
struct type *tpr = right->nd_type;
int errval = 1;
int allowed;
if (tpl->tp_fund == T_SUBRANGE) tpl = tpl->next;
if (tpr->tp_fund == T_SUBRANGE) tpr = tpr->next;
if (tpl == intorcard_type) {
if (tpr == int_type || tpr == card_type) {
left->nd_type = tpl = tpr;
@ -606,11 +684,11 @@ chk_oper(expp)
right->nd_type = tpr = tpl;
}
}
expp->nd_type = error_type;
expp->nd_type = ResultOfOperation(expp->nd_symb, tpl);
if (expp->nd_symb == IN) {
/* Handle this one specially */
expp->nd_type = bool_type;
if (tpr->tp_fund != T_SET) {
node_error(expp, "RHS of IN operator not a SET type");
return 0;
@ -630,9 +708,6 @@ node_error(expp, "IN operator: type of LHS not compatible with element type of R
return 1;
}
if (tpl->tp_fund == T_SUBRANGE) tpl = tpl->next;
expp->nd_type = tpl;
/* Operands must be compatible (distilled from Def 8.2)
*/
if (!TstCompat(tpl, tpr)) {
@ -641,128 +716,28 @@ node_error(expp, "IN operator: type of LHS not compatible with element type of R
return 0;
}
switch(expp->nd_symb) {
case '+':
case '-':
case '*':
switch(tpl->tp_fund) {
case T_POINTER:
if (! chk_address(tpl, tpr)) break;
/* Fall through */
case T_INTEGER:
case T_CARDINAL:
case T_INTORCARD:
if (left->nd_class==Value && right->nd_class==Value) {
cstbin(expp);
}
return 1;
case T_SET:
if (left->nd_class == Set && right->nd_class == Set) {
cstset(expp);
}
/* Fall through */
case T_REAL:
return 1;
allowed = AllowedTypes(expp->nd_symb);
if (!(tpl->tp_fund & allowed) ||
(tpl != bool_type && Boolean(expp->nd_symb))) {
if (!(tpl->tp_fund == T_POINTER &&
(T_CARDINAL & allowed) &&
chk_address(tpl, tpr))) {
node_error(expp,"operator \"%s\": illegal operand type(s)", symbol2str(expp->nd_symb));
return 0;
}
break;
case '/':
switch(tpl->tp_fund) {
case T_SET:
if (left->nd_class == Set && right->nd_class == Set) {
cstset(expp);
}
/* Fall through */
case T_REAL:
return 1;
}
break;
case DIV:
case MOD:
switch(tpl->tp_fund) {
case T_POINTER:
if (! chk_address(tpl, tpr)) break;
/* Fall through */
case T_INTEGER:
case T_CARDINAL:
case T_INTORCARD:
if (left->nd_class==Value && right->nd_class==Value) {
cstbin(expp);
}
return 1;
}
break;
case OR:
case AND:
case '&':
if (tpl == bool_type) {
if (left->nd_class==Value && right->nd_class==Value) {
cstbin(expp);
}
return 1;
}
errval = 3;
break;
case '=':
case '#':
case GREATEREQUAL:
case LESSEQUAL:
case '<':
case '>':
expp->nd_type = bool_type;
switch(tpl->tp_fund) {
case T_SET:
if (expp->nd_symb == '<' || expp->nd_symb == '>') {
break;
}
if (left->nd_class == Set && right->nd_class == Set) {
cstset(expp);
}
return 1;
case T_INTEGER:
case T_CARDINAL:
case T_ENUMERATION: /* includes boolean */
case T_CHAR:
case T_INTORCARD:
if (left->nd_class==Value && right->nd_class==Value) {
cstbin(expp);
}
return 1;
case T_HIDDEN:
case T_POINTER:
if (chk_address(tpl, tpr) ||
expp->nd_symb == '=' ||
expp->nd_symb == '#') return 1;
break;
case T_REAL:
return 1;
}
default:
assert(0);
}
switch(errval) {
case 1:
node_error(expp,"operator \"%s\": illegal operand type(s)", symbol2str(expp->nd_symb));
break;
case 3:
node_error(expp, "BOOLEAN type(s) expected");
break;
default:
assert(0);
if (tpl->tp_fund == T_SET) {
if (left->nd_class == Set && right->nd_class == Set) {
cstset(expp);
}
}
return 0;
else if ( tpl->tp_fund != T_REAL &&
left->nd_class == Value && right->nd_class == Value) {
cstbin(expp);
}
return 1;
}
int

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

@ -27,6 +27,7 @@ extern label text_label();
extern char *long2str();
extern char *symbol2str();
extern int proclevel;
int fp_used;
CodeConst(cst, size)
arith cst, size;
@ -43,7 +44,7 @@ CodeConst(cst, size)
}
else {
C_df_dlb(dlab = data_label());
C_rom_icon(long2str((long) cst), 10);
C_rom_icon(long2str((long) cst), size);
C_lae_dlb(dlab, (arith) 0);
C_loi(size);
}
@ -59,7 +60,7 @@ CodeString(nd)
}
else {
C_df_dlb(lab = data_label());
C_rom_scon(nd->nd_STR, align(nd->nd_SLE + 1, word_size));
C_rom_scon(nd->nd_STR, align(nd->nd_SLE + 1, (int) word_size));
C_lae_dlb(lab, (arith) 0);
}
}
@ -80,11 +81,8 @@ CodePadString(nd, sz)
assert(sizearg < sz);
C_zer(sz - sizearg);
}
C_asp(-sizearg); /* room for string */
CodeString(nd); /* push address of string */
C_lor((arith) 1); /* load stack pointer */
C_adp(pointer_size); /* and compute target address from it */
C_blm(sizearg); /* and copy */
C_loi(sizearg);
}
CodeReal(nd)
@ -103,7 +101,9 @@ CodeExpr(nd, ds, true_label, false_label)
register struct desig *ds;
label true_label, false_label;
{
register struct type *tp = nd->nd_type;
if (tp->tp_fund == T_REAL) fp_used = 1;
switch(nd->nd_class) {
case Def:
if (nd->nd_def->df_kind == D_PROCEDURE) {
@ -147,7 +147,7 @@ CodeExpr(nd, ds, true_label, false_label)
CodeString(nd);
break;
case INTEGER:
CodeConst(nd->nd_INT, nd->nd_type->tp_size);
CodeConst(nd->nd_INT, tp->tp_size);
break;
default:
crash("Value error");
@ -167,12 +167,10 @@ CodeExpr(nd, ds, true_label, false_label)
st = nd->nd_set;
ds->dsg_kind = DSG_LOADED;
if (!st) {
C_zer(nd->nd_type->tp_size);
C_zer(tp->tp_size);
break;
}
for (i = nd->nd_type->tp_size / word_size, st += i;
i > 0;
i--) {
for (i = tp->tp_size / word_size, st += i; i > 0; i--) {
C_loc(*--st);
}
}
@ -188,7 +186,7 @@ CodeExpr(nd, ds, true_label, false_label)
}
if (true_label != 0) {
CodeValue(ds, nd->nd_type->tp_size);
CodeValue(ds, tp->tp_size);
*ds = InitDesig;
C_zne(true_label);
C_bra(false_label);
@ -250,12 +248,12 @@ CodeCoercion(t1, t2)
}
break;
case T_INTEGER:
C_loc(t1->tp_size);
C_loc(word_size);
C_loc(t2->tp_size);
C_cui();
break;
case T_REAL:
C_loc(t1->tp_size);
C_loc(word_size);
C_loc(t2->tp_size);
C_cuf();
break;
@ -322,41 +320,44 @@ CodeCall(nd)
tp = TypeOfParam(param);
arg = arg->nd_right;
assert(arg != 0);
left = arg->nd_left;
if (IsConformantArray(tp)) {
C_loc(tp->arr_elsize);
if (IsConformantArray(arg->nd_left->nd_type)) {
DoHIGH(arg->nd_left);
if (IsConformantArray(left->nd_type)) {
DoHIGH(left);
}
else if (arg->nd_left->nd_symb == STRING) {
C_loc(arg->nd_left->nd_SLE);
else if (left->nd_symb == STRING) {
C_loc(left->nd_SLE);
}
else if (tp->arr_elem == word_type) {
C_loc(arg->nd_left->nd_type->tp_size / word_size - 1);
C_loc(left->nd_type->tp_size / word_size - 1);
}
else C_loc(arg->nd_left->nd_type->tp_size /
else C_loc(left->nd_type->tp_size /
tp->arr_elsize - 1);
C_loc(0);
if (arg->nd_left->nd_symb == STRING) {
CodeString(arg->nd_left);
C_loc((arith) 0);
if (left->nd_symb == STRING) {
CodeString(left);
}
else CodeDAddress(arg->nd_left);
else CodeDAddress(left);
pushed += pointer_size + 3 * word_size;
}
else if (IsVarParam(param)) {
CodeDAddress(arg->nd_left);
CodeDAddress(left);
pushed += pointer_size;
}
else {
if (arg->nd_left->nd_type->tp_fund == T_STRING) {
CodePadString(arg->nd_left,
if (left->nd_type->tp_fund == T_STRING) {
CodePadString(left,
align(tp->tp_size, word_align));
}
else CodePExpr(arg->nd_left);
CheckAssign(arg->nd_left->nd_type, tp);
else CodePExpr(left);
CheckAssign(left->nd_type, tp);
pushed += align(tp->tp_size, word_align);
}
}
left = nd->nd_left;
if (left->nd_class == Def && left->nd_def->df_kind == D_PROCEDURE) {
if (left->nd_def->df_scope->sc_level > 0) {
C_lxl((arith) proclevel - left->nd_def->df_scope->sc_level);
@ -944,15 +945,13 @@ CodeSet(nd)
{
struct type *tp = nd->nd_type;
C_zer(nd->nd_type->tp_size); /* empty set */
nd = nd->nd_right;
while (nd) {
assert(nd->nd_class == Link && nd->nd_symb == ',');
CodeEl(nd->nd_left, tp);
nd = nd->nd_right;
if (nd) {
C_ior(tp->tp_size);
}
}
}
@ -962,19 +961,19 @@ CodeEl(nd, tp)
{
if (nd->nd_class == Link && nd->nd_symb == UPTO) {
C_zer(tp->tp_size); /* empty set */
C_lor((arith) 1); /* SP: address of set */
C_loc(tp->tp_size); /* push size */
if (tp->next->tp_fund == T_SUBRANGE) {
C_loc(tp->next->sub_ub);
}
else C_loc(tp->next->enm_ncst - 1);
else C_loc((arith) (tp->next->enm_ncst - 1));
Operands(nd->nd_left, nd->nd_right);
C_cal("_LtoUset"); /* library routine to fill set */
C_asp(2 * word_size + pointer_size);
C_asp(4 * word_size);
}
else {
CodePExpr(nd);
C_set(tp->tp_size);
C_ior(tp->tp_size);
}
}

6
lang/m2/comp/cstoper.c
View file

@ -39,6 +39,9 @@ cstunary(expp)
break;
case '-':
o1 = -o1;
if (expp->nd_type->tp_fund == T_INTORCARD) {
expp->nd_type = int_type;
}
break;
case NOT:
case '~':
@ -149,6 +152,9 @@ cstbin(expp)
case '-':
o1 -= o2;
if (expp->nd_type->tp_fund == T_INTORCARD) {
if (o1 < 0) expp->nd_type = int_type;
}
break;
case '<':

20
lang/m2/comp/declar.g
View file

@ -22,7 +22,6 @@ static char *RcsId = "$Header$";
#include "main.h"
int proclevel = 0; /* nesting level of procedures */
extern char *sprint();
}
ProcedureDeclaration
@ -566,23 +565,22 @@ ConstantDeclaration
VariableDeclaration
{
struct node *VarList;
register struct node *nd;
struct type *tp;
} :
IdentAddrList(&VarList)
IdentAddr(&VarList)
{ nd = VarList; }
[
',' IdentAddr(&(nd->nd_right))
{ nd = nd->nd_right; }
]*
':' type(&tp)
{ EnterVarList(VarList, tp, proclevel > 0);
FreeNode(VarList);
}
;
IdentAddrList(struct node **pnd;)
{
} :
IdentAddr(struct node **pnd;) :
IDENT { *pnd = MkLeaf(Name, &dot); }
ConstExpression(&(*pnd)->nd_left)?
[ { pnd = &((*pnd)->nd_right); }
',' IDENT
{ *pnd = MkLeaf(Name, &dot); }
ConstExpression(&(*pnd)->nd_left)?
]*
ConstExpression(&((*pnd)->nd_left))?
;

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

@ -390,11 +390,12 @@ idn->nd_IDF->id_text);
else if (!(df = lookup(ids->nd_IDF, vis->sc_scope))) {
node_error(ids, "identifier \"%s\" not declared in qualifying module",
ids->nd_IDF->id_text);
df = ill_df;
df = define(ids->nd_IDF,vis->sc_scope,D_ERROR);
}
else if (!(df->df_flags&(D_EXPORTED|D_QEXPORTED))) {
node_error(ids,"identifier \"%s\" not exported from qualifying module",
ids->nd_IDF->id_text);
df->df_flags |= D_QEXPORTED;
}
}
else {
@ -459,9 +460,8 @@ DeclProc(type)
Also create a name for it.
*/
register struct def *df;
static int nmcount = 0;
extern char *strcpy();
extern char *sprint();
static int nmcount;
char buf[256];
assert(type & (D_PROCEDURE | D_PROCHEAD));
@ -472,8 +472,7 @@ DeclProc(type)
df = define(dot.TOK_IDF, CurrentScope, type);
df->for_node = MkLeaf(Name, &dot);
sprint(buf,"%s_%s",CurrentScope->sc_name,df->df_idf->id_text);
df->for_name = Malloc((unsigned) (strlen(buf)+1));
strcpy(df->for_name, buf);
df->for_name = Salloc(buf, (unsigned) (strlen(buf)+1));
C_exp(df->for_name);
open_scope(OPENSCOPE);
}
@ -491,16 +490,11 @@ DeclProc(type)
}
else {
df = define(dot.TOK_IDF, CurrentScope, type);
if (CurrVis != Defined->mod_vis) {
sprint(buf, "_%d_%s", ++nmcount,
df->df_idf->id_text);
}
else sprint(buf, "%s_%s",CurrentScope->sc_name,
df->df_idf->id_text);
open_scope(OPENSCOPE);
df->prc_vis = CurrVis;
CurrentScope->sc_name = Malloc((unsigned)(strlen(buf)+1));
strcpy(CurrentScope->sc_name, buf);
sprint(buf,"_%d_%s",++nmcount,df->df_idf->id_text);
CurrentScope->sc_name =
Salloc(buf, (unsigned)(strlen(buf)+1));
C_inp(buf);
}
}

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

@ -31,11 +31,9 @@ GetFile(name)
char buf[256];
char *strcpy(), *strcat();
(void) strcpy(buf, name);
if (strlen(buf) > 10) {
(void) strcpy(&buf[10], ".def");
}
else (void) strcat(buf, ".def");
strcpy(buf, name);
buf[10] = '\0'; /* maximum length */
strcat(buf, ".def");
if (! InsertFile(buf, DEFPATH, &(FileName))) {
fatal("Could'nt find a DEFINITION MODULE for \"%s\"", name);
}
@ -80,11 +78,3 @@ GetDefinitionModule(id)
level--;
return df;
}
AtEoIF()
{
/* Make the unstacking of input streams noticable by the
lexical analyzer
*/
return 1;
}

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

@ -246,19 +246,6 @@ CodeVarDesig(df, ds)
df->df_flags |= D_NOREG;
return;
}
if (sc->sc_level == 0) {
/* the variable is global, but declared in a module local
to the implementation or program module.
Such variables can be accessed through an offset from
the name of the module.
*/
ds->dsg_name = &(sc->sc_name[1]);
ds->dsg_offset = df->var_off;
ds->dsg_kind = DSG_FIXED;
df->df_flags |= D_NOREG;
return;
}
if (sc->sc_level != proclevel) {
/* the variable is local to a statically enclosing procedure.
@ -349,7 +336,7 @@ CodeDesig(nd, ds)
df = nd->nd_left->nd_def;
if (proclevel > df->df_scope->sc_level) {
C_lxa(proclevel - df->df_scope->sc_level);
C_lxa((arith) (proclevel - df->df_scope->sc_level));
C_adp(df->var_off + pointer_size);
}
else C_lal(df->var_off + pointer_size);

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

@ -118,7 +118,7 @@ EnterVarList(IdList, type, local)
register struct def *df;
register struct scopelist *sc;
char buf[256];
extern char *sprint(), *Malloc(), *strcpy();
extern char *sprint();
sc = CurrVis;
@ -151,24 +151,12 @@ node_error(IdList->nd_left,"Illegal type for address");
type->tp_align);
df->var_off = sc->sc_scope->sc_off;
}
else if (!DefinitionModule && CurrVis != Defined->mod_vis) {
/* variable list belongs to an internal global
module.
Align offset and add size
*/
sc->sc_scope->sc_off =
align(sc->sc_scope->sc_off, type->tp_align);
df->var_off = sc->sc_scope->sc_off;
df->var_name = 0;
sc->sc_scope->sc_off += type->tp_size;
}
else {
/* Global name, possibly external
*/
sprint(buf,"%s_%s", sc->sc_scope->sc_name,
df->df_idf->id_text);
df->var_name = Malloc((unsigned)(strlen(buf)+1));
strcpy(df->var_name, buf);
df->var_name = Salloc(buf, (unsigned)(strlen(buf)+1));
if (DefinitionModule) {
C_exa_dnam(df->var_name);

1
lang/m2/comp/expression.g
View file

@ -175,7 +175,6 @@ factor(struct node **p;)
{
struct def *df;
struct node *nd;
register struct type *tp;
} :
qualident(0, &df, (char *) 0, p)
[

15
lang/m2/comp/input.c
View file

@ -6,3 +6,18 @@
struct f_info file_info;
#include "input.h"
#include <inp_pkg.body>
AtEoIF()
{
/* Make the unstacking of input streams noticable to the
lexical analyzer
*/
return 1;
}
AtEoIT()
{
/* Make the end of the text noticable
*/
return 1;
}

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

@ -23,14 +23,15 @@ static char *RcsId = "$Header$";
#include "tokenname.h"
#include "node.h"
int state; /* either IMPLEMENTATION or PROGRAM */
char options[128];
int DefinitionModule;
int SYSTEMModule = 0;
char *ProgName;
char *DEFPATH[NDIRS+1];
struct def *Defined;
extern int err_occurred;
int state; /* either IMPLEMENTATION or PROGRAM */
char options[128];
int DefinitionModule;
int SYSTEMModule = 0;
char *ProgName;
char *DEFPATH[NDIRS+1];
struct def *Defined;
extern int err_occurred;
extern int fp_used; /* set if floating point used */
main(argc, argv)
char *argv[];
@ -75,8 +76,8 @@ Compile(src, dst)
init_idf();
InitCst();
reserve(tkidf);
init_scope();
init_types();
InitScope();
InitTypes();
InitDef();
AddStandards();
#ifdef DEBUG
@ -94,12 +95,16 @@ Compile(src, dst)
C_magic();
C_ms_emx(word_size, pointer_size);
CompUnit();
C_ms_src((arith) (LineNumber - 1), FileName);
close_scope(SC_REVERSE);
if (err_occurred) {
C_close();
return 0;
}
WalkModule(Defined);
if (fp_used) {
C_ms_flt();
}
C_close();
#ifdef DEBUG
if (options['m']) MemUse();
@ -210,17 +215,9 @@ END SYSTEM.\n";
}
SYSTEMModule = 1;
DefModule();
close_scope(0);
SYSTEMModule = 0;
}
AtEoIT()
{
/* Make the end of the text noticable
*/
return 1;
}
#ifdef DEBUG
MemUse()
{

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

@ -49,7 +49,7 @@ ModuleDeclaration
struct node *nd;
struct node *exportlist = 0;
int qualified;
extern char *sprint(), *Malloc(), *strcpy();
extern char *sprint();
} :
MODULE IDENT {
id = dot.TOK_IDF;
@ -67,10 +67,9 @@ ModuleDeclaration
df->df_type = standard_type(T_RECORD, 0, (arith) 0);
df->df_type->rec_scope = df->mod_vis->sc_scope;
sprint(buf, "__%d%s", ++modulecount, id->id_text);
sprint(buf, "_%d%s", ++modulecount, id->id_text);
CurrentScope->sc_name =
Malloc((unsigned) (strlen(buf) + 1));
strcpy(CurrentScope->sc_name, buf);
Salloc(buf, (unsigned) (strlen(buf) + 1));
if (! proclevel) C_ina_dnam(&buf[1]);
C_inp(buf);
}
@ -177,7 +176,7 @@ DefinitionModule
df->df_flags |= D_QEXPORTED;
df = df->df_nextinscope;
}
if (!SYSTEMModule) close_scope(SC_CHKFORW);
close_scope(SC_CHKFORW);
DefinitionModule--;
match_id(id, dot.TOK_IDF);
}

4
lang/m2/comp/scope.C
View file

@ -36,7 +36,7 @@ open_scope(scopetype)
assert(scopetype == OPENSCOPE || scopetype == CLOSEDSCOPE);
clear((char *) sc, sizeof (*sc));
clear((char *) sc, sizeof (struct scope));
sc->sc_scopeclosed = scopetype == CLOSEDSCOPE;
sc->sc_level = proclevel;
if (scopetype == OPENSCOPE) {
@ -48,7 +48,7 @@ open_scope(scopetype)
CurrVis = ls;
}
init_scope()
InitScope()
{
register struct scope *sc = new_scope();
register struct scopelist *ls = new_scopelist();

8
lang/m2/comp/standards.h
View file

@ -22,7 +22,7 @@
/* Standard procedures and functions defined in the SYSTEM module ... */
#define S_ADR 20
#define S_TSIZE 21
#define S_NEWPROCESS 22
#define S_TRANSFER 23
#define S_ADR 50
#define S_TSIZE 51
#define S_NEWPROCESS 52
#define S_TRANSFER 53

4
lang/m2/comp/type.c
View file

@ -153,7 +153,7 @@ standard_type(fund, align, size)
return tp;
}
init_types()
InitTypes()
{
/* Initialize the predefined types
*/
@ -434,7 +434,7 @@ ArrayElSize(tp)
if (tp->tp_fund == T_ARRAY) ArraySizes(tp);
algn = align(tp->tp_size, tp->tp_align);
if (!(algn % word_size == 0 || word_size % algn == 0)) {
algn = align(algn, word_size);
algn = align(algn, (int) word_size);
}
return algn;
}

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

@ -78,26 +78,10 @@ WalkModule(module)
CurrVis = module->mod_vis;
sc = CurrentScope;
if (!proclevel && module != Defined) {
/* This module is a local module, but not within a
procedure. Generate code to allocate storage for its
variables. This is done by generating a "bss",
with label "_<modulenumber><modulename>".
*/
arith size = align(sc->sc_off, word_align);
if (size == 0) size = word_size;
/* WHY ??? because we generated an INA for it ??? */
C_df_dnam(&(sc->sc_name[1]));
size = align(size, word_align);
C_bss_cst(size, (arith) 0, 0);
C_exp(sc->sc_name);
}
else if (CurrVis == Defined->mod_vis) {
/* This module is the module currently being compiled.
Again, generate code to allocate storage for its
variables, which all have an explicit name.
if (!proclevel) {
/* This module is a glocal module.
Generate code to allocate storage for its variables.
They all have an explicit name.
*/
while (df) {
if (df->df_kind == D_VARIABLE) {
@ -369,11 +353,9 @@ WalkStat(nd, lab)
struct node *fnd;
label l1 = instructionlabel++;
label l2 = instructionlabel++;
arith size;
if (! DoForInit(nd, left)) break;
fnd = left->nd_right;
size = fnd->nd_type->tp_size;
if (fnd->nd_class != Value) {
CodePExpr(fnd);
tmp = NewInt();
@ -513,7 +495,7 @@ DoForInit(nd, left)
if (! chk_designator(nd, VARIABLE, D_DEFINED) ||
! chk_expr(left->nd_left) ||
! chk_expr(left->nd_right)) return;
! chk_expr(left->nd_right)) return 0;
if (nd->nd_type->tp_size > word_size ||
!(nd->nd_type->tp_fund & T_DISCRETE)) {
@ -533,6 +515,8 @@ node_warning(nd, "old-fashioned! compatibility required in FOR statement");
CodePExpr(left->nd_left);
CodeDStore(nd);
return 1;
}
DoAssign(nd, left, right)