From c57d4ff268e1cdd3500aae31eed9c006765c1d17 Mon Sep 17 00:00:00 2001 From: ceriel Date: Mon, 1 Dec 1986 10:06:53 +0000 Subject: [PATCH] some minor bug fixes --- lang/m2/comp/LLlex.c | 16 +++++++++-- lang/m2/comp/LLmessage.c | 57 ++++++++++++++++++---------------------- lang/m2/comp/Makefile | 4 +-- lang/m2/comp/chk_expr.c | 21 ++++++++------- lang/m2/comp/code.c | 29 ++++++++++++-------- lang/m2/comp/declar.g | 15 ++++++++--- lang/m2/comp/def.H | 2 +- lang/m2/comp/enter.c | 30 ++++++++++----------- lang/m2/comp/main.c | 6 ++--- lang/m2/comp/program.g | 26 +++++++++--------- lang/m2/comp/scope.C | 12 ++++++--- lang/m2/comp/scope.h | 6 ++--- lang/m2/comp/tokenname.c | 2 +- lang/m2/comp/type.c | 11 +++++--- lang/m2/comp/walk.c | 34 +++++++++++++++++++----- 15 files changed, 165 insertions(+), 106 deletions(-) diff --git a/lang/m2/comp/LLlex.c b/lang/m2/comp/LLlex.c index 902ed71b9..0a4f021af 100644 --- a/lang/m2/comp/LLlex.c +++ b/lang/m2/comp/LLlex.c @@ -411,8 +411,20 @@ again1: /* Fall through */ case End: - *np++ = '\0'; - tk->TOK_INT = str2long(&buf[1], base); + *np = '\0'; + if (np >= &buf[NUMSIZE]) { + tk->TOK_INT = 1; + lexerror("constant too long"); + } + else { + np = &buf[1]; + while (*np == '0') np++; + tk->TOK_INT = str2long(np, base); + if (strlen(np) > 14 /* ??? */ || + tk->TOK_INT < 0) { +lexwarning(W_ORDINARY, "overflow in constant"); + } + } if (ch == 'C' && base == 8) { toktype = char_type; if (tk->TOK_INT<0 || tk->TOK_INT>255) { diff --git a/lang/m2/comp/LLmessage.c b/lang/m2/comp/LLmessage.c index 7de4385aa..a63866212 100644 --- a/lang/m2/comp/LLmessage.c +++ b/lang/m2/comp/LLmessage.c @@ -16,16 +16,39 @@ extern char *symbol2str(); extern struct idf *gen_anon_idf(); -extern int err_occurred; LLmessage(tk) - int tk; + register int tk; { if (tk > 0) { /* if (tk > 0), it represents the token to be inserted. */ + register struct token *dotp = ˙ + error("%s missing", symbol2str(tk)); - insert_token(tk); + + aside = *dotp; + + dotp->tk_symb = tk; + + switch (tk) { + /* The operands need some body */ + case IDENT: + dotp->TOK_IDF = gen_anon_idf(); + break; + case STRING: + dotp->tk_data.tk_str = (struct string *) + Malloc(sizeof (struct string)); + dotp->TOK_SLE = 1; + dotp->TOK_STR = Salloc("", 1); + break; + case INTEGER: + dotp->TOK_INT = 1; + break; + case REAL: + dotp->TOK_REL = Salloc("0.0", 4); + break; + } } else if (tk < 0) { error("garbage at end of program"); @@ -33,31 +56,3 @@ LLmessage(tk) else error("%s deleted", symbol2str(dot.tk_symb)); } -insert_token(tk) - int tk; -{ - register struct token *dotp = ˙ - - aside = *dotp; - - dotp->tk_symb = tk; - - switch (tk) { - /* The operands need some body */ - case IDENT: - dotp->TOK_IDF = gen_anon_idf(); - break; - case STRING: - dotp->tk_data.tk_str = (struct string *) - Malloc(sizeof (struct string)); - dotp->TOK_SLE = 1; - dotp->TOK_STR = Salloc("", 1); - break; - case INTEGER: - dotp->TOK_INT = 1; - break; - case REAL: - dotp->TOK_REL = Salloc("0.0", 4); - break; - } -} diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile index d434e74ef..d62ebacf1 100644 --- a/lang/m2/comp/Makefile +++ b/lang/m2/comp/Makefile @@ -141,8 +141,8 @@ type.o: LLlex.h const.h debug.h debugcst.h def.h idf.h maxset.h node.h scope.h t def.o: LLlex.h Lpars.h debug.h debugcst.h def.h idf.h main.h node.h scope.h type.h scope.o: LLlex.h debug.h debugcst.h def.h idf.h node.h scope.h type.h misc.o: LLlex.h f_info.h idf.h misc.h node.h -enter.o: LLlex.h debug.h debugcst.h def.h idf.h main.h node.h scope.h type.h -defmodule.o: LLlex.h Lpars.h debug.h debugcst.h def.h f_info.h idf.h input.h inputtype.h main.h node.h scope.h type.h +enter.o: LLlex.h debug.h debugcst.h def.h idf.h main.h misc.h node.h scope.h type.h +defmodule.o: LLlex.h Lpars.h debug.h debugcst.h def.h f_info.h idf.h input.h inputtype.h main.h misc.h node.h scope.h type.h typequiv.o: LLlex.h debug.h debugcst.h def.h node.h type.h warning.h node.o: LLlex.h debug.h debugcst.h def.h node.h type.h cstoper.o: LLlex.h Lpars.h debug.h debugcst.h idf.h node.h standards.h target_sizes.h type.h warning.h diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c index d97a51f2e..401571d5f 100644 --- a/lang/m2/comp/chk_expr.c +++ b/lang/m2/comp/chk_expr.c @@ -994,23 +994,24 @@ ChkStandard(expp, left) /* Now, make it look like a call to ALLOCATE or DEALLOCATE */ { struct token dt; + register struct token *tk = &dt; struct node *nd; - dt.TOK_INT = PointedtoType(left->nd_type)->tp_size; - dt.tk_symb = INTEGER; - dt.tk_lineno = left->nd_lineno; + tk->TOK_INT = PointedtoType(left->nd_type)->tp_size; + tk->tk_symb = INTEGER; + tk->tk_lineno = left->nd_lineno; nd = MkLeaf(Value, &dt); nd->nd_type = card_type; - dt.tk_symb = ','; - arg->nd_right = MkNode(Link, nd, NULLNODE, &dt); + tk->tk_symb = ','; + arg->nd_right = MkNode(Link, nd, NULLNODE, tk); /* Ignore other arguments to NEW and/or DISPOSE ??? */ FreeNode(expp->nd_left); - dt.tk_symb = IDENT; - dt.tk_lineno = expp->nd_left->nd_lineno; - dt.TOK_IDF = str2idf(std == S_NEW ? + tk->tk_symb = IDENT; + tk->tk_lineno = expp->nd_left->nd_lineno; + tk->TOK_IDF = str2idf(std == S_NEW ? "ALLOCATE" : "DEALLOCATE", 0); - expp->nd_left = MkLeaf(Name, &dt); + expp->nd_left = MkLeaf(Name, tk); } return ChkCall(expp); @@ -1145,7 +1146,7 @@ ChkCast(expp, left) } TryToString(nd, tp) - struct node *nd; + register struct node *nd; struct type *tp; { /* Try a coercion from character constant to string. diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c index bbef689fa..d415d7a9e 100644 --- a/lang/m2/comp/code.c +++ b/lang/m2/comp/code.c @@ -401,16 +401,7 @@ CodeParameters(param, arg) return; } if (left_type->tp_fund == T_STRING) { - register arith szarg = WA(left_type->tp_size); - arith sz = WA(tp->tp_size); - - if (szarg != sz) { - /* null padding required */ - assert(szarg < sz); - C_zer(sz - szarg); - } - CodeString(left); /* push address of string */ - C_loi(szarg); + CodePString(left, tp); return; } CodePExpr(left); @@ -418,6 +409,22 @@ CodeParameters(param, arg) CodeCoercion(left_type, tp); } +CodePString(nd, tp) + struct node *nd; + struct type *tp; +{ + arith szarg = WA(nd->nd_type->tp_size); + register arith zersz = WA(tp->tp_size) - szarg; + + if (zersz) { + /* null padding required */ + assert(zersz > 0); + C_zer(zersz); + } + CodeString(nd); /* push address of string */ + C_loi(szarg); +} + CodeStd(nd) struct node *nd; { @@ -731,8 +738,8 @@ CodeOper(expr, true_label, false_label) C_cmi(tp->tp_size); break; case T_POINTER: - case T_EQUAL: case T_HIDDEN: + case T_EQUAL: case T_CARDINAL: case T_INTORCARD: C_cmu(tp->tp_size); diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g index c08bfe128..7e93eb902 100644 --- a/lang/m2/comp/declar.g +++ b/lang/m2/comp/declar.g @@ -116,10 +116,15 @@ TypeDeclaration { struct def *df; struct type *tp; + struct node *nd; }: - IDENT { df = define(dot.TOK_IDF, CurrentScope, D_TYPE); } + IDENT { df = define(dot.TOK_IDF, CurrentScope, D_TYPE); + nd = MkLeaf(Name, &dot); + } '=' type(&tp) - { DeclareType(df, tp); } + { DeclareType(nd, df, tp); + free_node(nd); + } ; type(struct type **ptp;): @@ -239,7 +244,11 @@ RecordType(struct type **ptp;) close_scope(0); } FieldListSequence(scope, &size, &xalign) - { *ptp = standard_type(T_RECORD, xalign, size); + { if (size == 0) { + warning(W_ORDINARY, "empty record declaration"); + size = 1; + } + *ptp = standard_type(T_RECORD, xalign, size); (*ptp)->rec_scope = scope; } END diff --git a/lang/m2/comp/def.H b/lang/m2/comp/def.H index a1725310c..d27f32c72 100644 --- a/lang/m2/comp/def.H +++ b/lang/m2/comp/def.H @@ -1,7 +1,7 @@ /* I D E N T I F I E R D E S C R I P T O R S T R U C T U R E */ struct module { - arith mo_priority; /* priority of a module */ + struct node *mo_priority;/* priority of a module */ struct scopelist *mo_vis;/* scope of this module */ struct node *mo_body; /* body of this module */ #define mod_priority df_value.df_module.mo_priority diff --git a/lang/m2/comp/enter.c b/lang/m2/comp/enter.c index 0680a0b5f..52debbc75 100644 --- a/lang/m2/comp/enter.c +++ b/lang/m2/comp/enter.c @@ -15,6 +15,7 @@ #include "LLlex.h" #include "node.h" #include "main.h" +#include "misc.h" struct def * Enter(name, kind, type, pnam) @@ -351,14 +352,8 @@ EnterExportList(Idlist, qualified) } if (df1->df_kind == D_HIDDEN && df->df_kind == D_TYPE) { - if (df->df_type->tp_fund != T_POINTER) { - node_error(idlist, -"opaque type \"%s\" is not a pointer type", - df->df_idf->id_text); - } - assert(df1->df_type->next == NULLTYPE); + DeclareType(idlist, df1, df->df_type); df1->df_kind = D_TYPE; - df1->df_type->next = df->df_type; continue; } } @@ -379,6 +374,7 @@ EnterFromImportList(Idlist, FromDef, FromId) register struct node *idlist = Idlist; register struct scopelist *vis; register struct def *df; + char *module_name = FromDef->df_idf->id_text; int forwflag = 0; switch(FromDef->df_kind) { @@ -399,27 +395,31 @@ EnterFromImportList(Idlist, FromDef, FromId) case D_MODULE: vis = FromDef->mod_vis; if (vis == CurrVis) { -node_error(FromId, "cannot import from current module \"%s\"", - FromDef->df_idf->id_text); +node_error(FromId, "cannot import from current module \"%s\"", module_name); return; } break; default: -node_error(FromId, "identifier \"%s\" does not represent a module", - FromDef->df_idf->id_text); +node_error(FromId,"identifier \"%s\" does not represent a module",module_name); return; } for (; idlist; idlist = idlist->next) { if (forwflag) df = ForwDef(idlist, vis->sc_scope); else if (! (df = lookup(idlist->nd_IDF, vis->sc_scope, 1))) { - not_declared("identifier", idlist, " in qualifying module"); - df = define(idlist->nd_IDF,vis->sc_scope,D_ERROR); + if (! is_anon_idf(idlist->nd_IDF)) { + node_error(idlist, + "identifier \"%s\" not declared in module \"%s\"", + idlist->nd_IDF->id_text, + module_name); + } + df = define(idlist->nd_IDF,vis->sc_scope,D_ERROR); } else if (! (df->df_flags & (D_EXPORTED|D_QEXPORTED))) { node_error(idlist, - "identifier \"%s\" not exported from qualifying module", - idlist->nd_IDF->id_text); + "identifier \"%s\" not exported from module \"%s\"", + idlist->nd_IDF->id_text, + module_name); df->df_flags |= D_QEXPORTED; } DoImport(df, CurrentScope); diff --git a/lang/m2/comp/main.c b/lang/m2/comp/main.c index 10c44f0e1..babf46810 100644 --- a/lang/m2/comp/main.c +++ b/lang/m2/comp/main.c @@ -81,15 +81,15 @@ Compile(src, dst) return 1; } #endif DEBUG - open_scope(CLOSEDSCOPE); - GlobalScope = CurrentScope; + open_scope(OPENSCOPE); + GlobalVis = CurrVis; + close_scope(0); C_init(word_size, pointer_size); if (! C_open(dst)) fatal("could not open output file"); 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_exp(Defined->mod_vis->sc_scope->sc_name); WalkModule(Defined); diff --git a/lang/m2/comp/program.g b/lang/m2/comp/program.g index f7eed0d12..e80578c86 100644 --- a/lang/m2/comp/program.g +++ b/lang/m2/comp/program.g @@ -44,7 +44,7 @@ ModuleDeclaration int qualified; } : MODULE IDENT { df = DefineLocalModule(dot.TOK_IDF); } - priority(&(df->mod_priority))? + priority(df) ';' import(1)* export(&qualified, &exportlist)? @@ -57,19 +57,21 @@ ModuleDeclaration } ; -priority(arith *pprio;) +priority(register struct def *df;) { register struct node *nd; - struct node *nd1; /* &nd is illegal */ } : - '[' ConstExpression(&nd1) ']' - { nd = nd1; - if (!(nd->nd_type->tp_fund & T_CARDINAL)) { - node_error(nd, "illegal priority"); + [ + '[' ConstExpression(&(df->mod_priority)) ']' + { if (!(df->mod_priority->nd_type->tp_fund & + T_CARDINAL)) { + node_error(df->mod_priority, + "illegal priority"); } - *pprio = nd->nd_INT; - FreeNode(nd); } + | + { df->mod_priority = 0; } + ] ; export(int *QUALflag; struct node **ExportList;): @@ -121,7 +123,7 @@ DefinitionModule if (!Defined) Defined = df; CurrentScope->sc_name = df->df_idf->id_text; df->mod_vis = CurrVis; - df->df_type = standard_type(T_RECORD, 1, (arith) 0); + df->df_type = standard_type(T_RECORD, 1, (arith) 1); df->df_type->rec_scope = df->mod_vis->sc_scope; DefinitionModule++; } @@ -194,14 +196,14 @@ ProgramModule RemoveImports(&(CurrentScope->sc_def)); } else { - Defined = df = define(dot.TOK_IDF, CurrentScope, D_MODULE); + Defined = df = define(dot.TOK_IDF, GlobalScope, D_MODULE); open_scope(CLOSEDSCOPE); df->mod_vis = CurrVis; CurrentScope->sc_name = "_M2M"; } CurrentScope->sc_definedby = df; } - priority(&(df->mod_priority))? + priority(df) ';' import(0)* block(&(df->mod_body)) IDENT { close_scope(SC_CHKFORW|SC_CHKPROC|SC_REVERSE); diff --git a/lang/m2/comp/scope.C b/lang/m2/comp/scope.C index e94f895cf..790e0ad24 100644 --- a/lang/m2/comp/scope.C +++ b/lang/m2/comp/scope.C @@ -14,8 +14,8 @@ #include "def.h" #include "node.h" -struct scope *PervasiveScope, *GlobalScope; -struct scopelist *CurrVis; +struct scope *PervasiveScope; +struct scopelist *CurrVis, *GlobalVis; extern int proclevel; static struct scopelist *PervVis; extern char options[]; @@ -85,9 +85,14 @@ chk_proc(df) { /* Called at scope closing. Check all definitions, and if one is a D_PROCHEAD, the procedure was not defined. + Also check that hidden types are defined. */ while (df) { - if (df->df_kind == D_PROCHEAD) { + if (df->df_kind == D_HIDDEN) { + error("hidden type \"%s\" not declared", + df->df_idf->id_text); + } + else if (df->df_kind == D_PROCHEAD) { /* A not defined procedure */ error("procedure \"%s\" not defined", @@ -121,6 +126,7 @@ node_error(df1->df_forw_node, "\"%s\" is not a type", df1->df_idf->id_text); df1->df_forw_type->next = df->df_type; FreeNode(df1->df_forw_node); free_def(df1); + continue; } else if (df->df_kind == D_FTYPE) { df->df_kind = D_TYPE; diff --git a/lang/m2/comp/scope.h b/lang/m2/comp/scope.h index 8e105b723..2fd385b30 100644 --- a/lang/m2/comp/scope.h +++ b/lang/m2/comp/scope.h @@ -30,13 +30,13 @@ struct scopelist { }; extern struct scope - *PervasiveScope, - *GlobalScope; + *PervasiveScope; extern struct scopelist - *CurrVis; + *CurrVis, *GlobalVis; #define CurrentScope (CurrVis->sc_scope) +#define GlobalScope (GlobalVis->sc_scope) #define enclosing(x) ((x)->sc_encl) #define scopeclosed(x) ((x)->sc_scopeclosed) #define nextvisible(x) ((x)->next) /* use with scopelists */ diff --git a/lang/m2/comp/tokenname.c b/lang/m2/comp/tokenname.c index 1de739fdf..223c2a66d 100644 --- a/lang/m2/comp/tokenname.c +++ b/lang/m2/comp/tokenname.c @@ -14,7 +14,7 @@ struct tokenname tkspec[] = { /* the names of the special tokens */ {IDENT, "identifier"}, {STRING, "string"}, - {INTEGER, "integer"}, + {INTEGER, "number"}, {REAL, "real"}, {0, ""} }; diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c index 134cbec6a..d30e19e54 100644 --- a/lang/m2/comp/type.c +++ b/lang/m2/comp/type.c @@ -473,9 +473,10 @@ FreeType(tp) free_type(tp); } -DeclareType(df, tp) +DeclareType(nd, df, tp) register struct def *df; register struct type *tp; + struct node *nd; { /* A type with type-description "tp" is declared and must be bound to definition "df". @@ -486,7 +487,9 @@ DeclareType(df, tp) if (df->df_type && df->df_type->tp_fund == T_HIDDEN) { if (! (tp->tp_fund & (T_POINTER|T_HIDDEN|T_EQUAL))) { -error("opaque type \"%s\" is not a pointer type", df->df_idf->id_text); + node_error(nd, + "opaque type \"%s\" is not a pointer type", + df->df_idf->id_text); } df->df_type->next = tp; df->df_type->tp_fund = T_EQUAL; @@ -495,7 +498,9 @@ error("opaque type \"%s\" is not a pointer type", df->df_idf->id_text); } if (tp == df->df_type) { /* Circular definition! */ -error("opaque type \"%s\" has a circular definition", df->df_idf->id_text); + node_error(nd, + "opaque type \"%s\" has a circular definition", + df->df_idf->id_text); } } else df->df_type = tp; diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c index 4a6da47e6..4fce40119 100644 --- a/lang/m2/comp/walk.c +++ b/lang/m2/comp/walk.c @@ -34,10 +34,29 @@ label data_label; static struct type *func_type; struct withdesig *WithDesigs; struct node *Modules; +static struct node *priority; #define NO_EXIT_LABEL ((label) 0) #define RETURN_LABEL ((label) 1) +STATIC +DoPriority() +{ + if (priority) { + C_loc(priority->nd_INT); + C_cal("_stackprio"); + C_asp(word_size); + } +} + +STATIC +EndPriority() +{ + if (priority) { + C_cal("_unstackprio"); + } +} + STATIC DoProfil() { @@ -67,6 +86,7 @@ WalkModule(module) struct scopelist *savevis = CurrVis; CurrVis = module->mod_vis; + priority = module->mod_priority; sc = CurrentScope; /* Walk through it's local definitions @@ -81,6 +101,7 @@ WalkModule(module) text_label = 1; /* label at end of initialization routine */ TmpOpen(sc); /* Initialize for temporaries */ C_pro_narg(sc->sc_name); + DoPriority(); DoProfil(); if (module == Defined) { /* Body of implementation or program module. @@ -113,6 +134,7 @@ WalkModule(module) DO_DEBUG(options['X'], PrNode(module->mod_body, 0)); WalkNode(module->mod_body, NO_EXIT_LABEL); C_df_ilb(RETURN_LABEL); + EndPriority(); C_ret((arith) 0); C_end(-sc->sc_off); proclevel--; @@ -146,6 +168,7 @@ WalkProcedure(procedure) /* Generate code for this procedure */ C_pro_narg(sc->sc_name); + DoPriority(); DoProfil(); TmpOpen(sc); @@ -277,6 +300,7 @@ WalkProcedure(procedure) C_ass(word_size); } C_lae_dlb(func_res_label, (arith) 0); + EndPriority(); C_ret(pointer_size); } else if (tp) { @@ -292,6 +316,7 @@ WalkProcedure(procedure) C_lal(retsav); C_loi(func_res_size); } + EndPriority(); C_ret(func_res_size); } else { @@ -299,6 +324,7 @@ WalkProcedure(procedure) C_lol(StackAdjustment); C_ass(word_size); } + EndPriority(); C_ret((arith) 0); } if (StackAdjustment) FreeInt(StackAdjustment); @@ -324,7 +350,7 @@ WalkDef(df) WalkProcedure(df); break; case D_VARIABLE: - if (!proclevel) { + if (!proclevel && !df->var_addrgiven) { C_df_dnam(df->var_name); C_bss_cst( WA(df->df_type->tp_size), @@ -554,11 +580,7 @@ node_error(right, "type incompatibility in RETURN statement"); break; } if (right->nd_type->tp_fund == T_STRING) { - arith strsize = WA(right->nd_type->tp_size); - - C_zer(WA(func_type->tp_size) - strsize); - CodePExpr(right); - C_loi(strsize); + CodePString(right, func_type); } else CodePExpr(right); } -- 2.34.1