From caf99ea4721b2ff5a1afa43a734ed33bc4250ff0 Mon Sep 17 00:00:00 2001 From: ceriel Date: Fri, 6 Jun 1986 02:22:09 +0000 Subject: [PATCH] newer version --- lang/m2/comp/LLlex.c | 18 +-- lang/m2/comp/chk_expr.c | 237 +++++++++++++++++--------------------- lang/m2/comp/code.c | 71 ++++++------ lang/m2/comp/cstoper.c | 6 + lang/m2/comp/declar.g | 20 ++-- lang/m2/comp/def.c | 20 ++-- lang/m2/comp/defmodule.c | 16 +-- lang/m2/comp/desig.c | 15 +-- lang/m2/comp/enter.c | 16 +-- lang/m2/comp/expression.g | 1 - lang/m2/comp/input.c | 15 +++ lang/m2/comp/main.c | 33 +++--- lang/m2/comp/program.g | 9 +- lang/m2/comp/scope.C | 4 +- lang/m2/comp/standards.h | 8 +- lang/m2/comp/type.c | 4 +- lang/m2/comp/walk.c | 30 ++--- 17 files changed, 223 insertions(+), 300 deletions(-) diff --git a/lang/m2/comp/LLlex.c b/lang/m2/comp/LLlex.c index e4a15ab91..1f87f78b5 100644 --- a/lang/m2/comp/LLlex.c +++ b/lang/m2/comp/LLlex.c @@ -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*/ } diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c index 49163d6a4..6fed17777 100644 --- a/lang/m2/comp/chk_expr.c +++ b/lang/m2/comp/chk_expr.c @@ -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; - } - 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; + 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; } - 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; + if (tpl->tp_fund == T_SET) { + if (left->nd_class == Set && right->nd_class == Set) { + cstset(expp); } - - 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); + else if ( tpl->tp_fund != T_REAL && + left->nd_class == Value && right->nd_class == Value) { + cstbin(expp); } - return 0; + + return 1; } int diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c index ca7203184..4566bc3ae 100644 --- a/lang/m2/comp/code.c +++ b/lang/m2/comp/code.c @@ -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); } } diff --git a/lang/m2/comp/cstoper.c b/lang/m2/comp/cstoper.c index 7c0453a5a..617ef95d1 100644 --- a/lang/m2/comp/cstoper.c +++ b/lang/m2/comp/cstoper.c @@ -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 '<': diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g index 84174ed80..a0f871041 100644 --- a/lang/m2/comp/declar.g +++ b/lang/m2/comp/declar.g @@ -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))? ; diff --git a/lang/m2/comp/def.c b/lang/m2/comp/def.c index 80bc6ea22..6f3344ec4 100644 --- a/lang/m2/comp/def.c +++ b/lang/m2/comp/def.c @@ -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); } } diff --git a/lang/m2/comp/defmodule.c b/lang/m2/comp/defmodule.c index fe6d63c1e..1696facd5 100644 --- a/lang/m2/comp/defmodule.c +++ b/lang/m2/comp/defmodule.c @@ -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; -} diff --git a/lang/m2/comp/desig.c b/lang/m2/comp/desig.c index 47780bfc6..69eb62b84 100644 --- a/lang/m2/comp/desig.c +++ b/lang/m2/comp/desig.c @@ -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); diff --git a/lang/m2/comp/enter.c b/lang/m2/comp/enter.c index b2bb3bf56..424c423bb 100644 --- a/lang/m2/comp/enter.c +++ b/lang/m2/comp/enter.c @@ -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); diff --git a/lang/m2/comp/expression.g b/lang/m2/comp/expression.g index 80a75780d..983042cd7 100644 --- a/lang/m2/comp/expression.g +++ b/lang/m2/comp/expression.g @@ -175,7 +175,6 @@ factor(struct node **p;) { struct def *df; struct node *nd; - register struct type *tp; } : qualident(0, &df, (char *) 0, p) [ diff --git a/lang/m2/comp/input.c b/lang/m2/comp/input.c index bc6088858..7dd53d9ba 100644 --- a/lang/m2/comp/input.c +++ b/lang/m2/comp/input.c @@ -6,3 +6,18 @@ struct f_info file_info; #include "input.h" #include + +AtEoIF() +{ + /* Make the unstacking of input streams noticable to the + lexical analyzer + */ + return 1; +} + +AtEoIT() +{ + /* Make the end of the text noticable + */ + return 1; +} diff --git a/lang/m2/comp/main.c b/lang/m2/comp/main.c index 1372165b4..54857dddf 100644 --- a/lang/m2/comp/main.c +++ b/lang/m2/comp/main.c @@ -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() { diff --git a/lang/m2/comp/program.g b/lang/m2/comp/program.g index cbf86b8a9..cf8aed10d 100644 --- a/lang/m2/comp/program.g +++ b/lang/m2/comp/program.g @@ -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); } diff --git a/lang/m2/comp/scope.C b/lang/m2/comp/scope.C index c359cfc53..f1731fb32 100644 --- a/lang/m2/comp/scope.C +++ b/lang/m2/comp/scope.C @@ -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(); diff --git a/lang/m2/comp/standards.h b/lang/m2/comp/standards.h index c7841b0bf..983b13e38 100644 --- a/lang/m2/comp/standards.h +++ b/lang/m2/comp/standards.h @@ -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 diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c index 974c8669e..89360b85c 100644 --- a/lang/m2/comp/type.c +++ b/lang/m2/comp/type.c @@ -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; } diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c index eb655e678..cc48c91c5 100644 --- a/lang/m2/comp/walk.c +++ b/lang/m2/comp/walk.c @@ -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 "_". - */ - 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) -- 2.34.1