diff --git a/lang/m2/comp/LLlex.c b/lang/m2/comp/LLlex.c index 03bf5bfad..3c6a047b7 100644 --- a/lang/m2/comp/LLlex.c +++ b/lang/m2/comp/LLlex.c @@ -156,13 +156,6 @@ getch() return ch; } -STATIC -linedirective() { - /* Read a line directive - */ - register int ch; -} - CheckForLineDirective() { register int ch = getch(); @@ -529,7 +522,7 @@ lexwarning(W_ORDINARY, "character constant out of range"); tk->TOK_REL = Salloc("0.0", 5); lexerror("floating constant too long"); } - else tk->TOK_REL = Salloc(buf, np - buf) + 1; + else tk->TOK_REL = Salloc(buf, (unsigned) (np - buf)) + 1; toktype = real_type; return tk->tk_symb = REAL; diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile index bf27961a8..fb1d9ee1a 100644 --- a/lang/m2/comp/Makefile +++ b/lang/m2/comp/Makefile @@ -20,7 +20,7 @@ PROFILE = CFLAGS = $(PROFILE) $(INCLUDES) -O -DSTATIC= LINTFLAGS = -DSTATIC= -DNORCSID MALLOC = $(LIBDIR)/malloc.o -LFLAGS = $(PROFILE) +LDFLAGS = -i $(PROFILE) LSRC = tokenfile.c program.c declar.c expression.c statement.c LOBJ = tokenfile.o program.o declar.o expression.o statement.o CSRC = LLlex.c LLmessage.c error.c main.c \ @@ -34,7 +34,7 @@ COBJ = LLlex.o LLmessage.o char.o error.o main.o \ cstoper.o chk_expr.o options.o walk.o casestat.o desig.o \ code.o tmpvar.o lookup.o Version.o next.o GENC= $(LSRC) symbol2str.c char.c Lpars.c casestat.c tmpvar.c scope.c next.c -SRC = $(CSRC) $(GENC) Lpars.c +SRC = $(CSRC) $(GENC) OBJ = $(COBJ) $(LOBJ) Lpars.o GENH= errout.h\ @@ -137,10 +137,18 @@ depend: #INCLINCLINCLINCL Xlint: - lint $(INCLUDES) $(LINTFLAGS) $(SRC) + lint $(INCLUDES) $(LINTFLAGS) $(SRC) \ + $(LIBDIR)/llib-lem_mes.ln \ + $(LIBDIR)/llib-lemk.ln \ + $(LIBDIR)/llib-linput.ln \ + $(LIBDIR)/llib-lassert.ln \ + $(LIBDIR)/llib-lalloc.ln \ + $(LIBDIR)/llib-lprint.ln \ + $(LIBDIR)/llib-lstring.ln \ + $(LIBDIR)/llib-lsystem.ln $(CURRDIR)/main: $(OBJ) - $(CC) $(LFLAGS) $(OBJ) $(LIBDIR)/libem_mes.a $(OBJECTCODE) $(LIBDIR)/libinput.a $(LIBDIR)/libassert.a $(LIBDIR)/liballoc.a $(MALLOC) $(LIBDIR)/libprint.a $(LIBDIR)/libstring.a $(LIBDIR)/libsystem.a -o $(CURRDIR)/main + $(CC) $(LDFLAGS) $(OBJ) $(LIBDIR)/libem_mes.a $(OBJECTCODE) $(LIBDIR)/libinput.a $(LIBDIR)/libassert.a $(LIBDIR)/liballoc.a $(MALLOC) $(LIBDIR)/libprint.a $(LIBDIR)/libstring.a $(LIBDIR)/libsystem.a -o $(CURRDIR)/main size $(CURRDIR)/main #AUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTO @@ -162,7 +170,6 @@ LLlex.o: warning.h LLmessage.o: LLlex.h LLmessage.o: Lpars.h LLmessage.o: idf.h -char.o: class.h error.o: LLlex.h error.o: debug.h error.o: debugcst.h @@ -189,7 +196,6 @@ main.o: standards.h main.o: tokenname.h main.o: type.h main.o: warning.h -symbol2str.o: Lpars.h tokenname.o: Lpars.h tokenname.o: idf.h tokenname.o: tokenname.h @@ -223,14 +229,6 @@ def.o: main.h def.o: node.h def.o: scope.h def.o: type.h -scope.o: LLlex.h -scope.o: debug.h -scope.o: debugcst.h -scope.o: def.h -scope.o: idf.h -scope.o: node.h -scope.o: scope.h -scope.o: type.h misc.o: LLlex.h misc.o: f_info.h misc.o: idf.h @@ -316,15 +314,6 @@ walk.o: scope.h walk.o: type.h walk.o: walk.h walk.o: warning.h -casestat.o: LLlex.h -casestat.o: Lpars.h -casestat.o: debug.h -casestat.o: debugcst.h -casestat.o: density.h -casestat.o: desig.h -casestat.o: node.h -casestat.o: type.h -casestat.o: walk.h desig.o: LLlex.h desig.o: debug.h desig.o: debugcst.h @@ -344,12 +333,6 @@ code.o: scope.h code.o: standards.h code.o: type.h code.o: walk.h -tmpvar.o: debug.h -tmpvar.o: debugcst.h -tmpvar.o: def.h -tmpvar.o: main.h -tmpvar.o: scope.h -tmpvar.o: type.h lookup.o: LLlex.h lookup.o: debug.h lookup.o: debugcst.h @@ -359,8 +342,6 @@ lookup.o: misc.h lookup.o: node.h lookup.o: scope.h lookup.o: type.h -next.o: debug.h -next.o: debugcst.h tokenfile.o: Lpars.h program.o: LLlex.h program.o: Lpars.h @@ -405,4 +386,31 @@ statement.o: idf.h statement.o: node.h statement.o: scope.h statement.o: type.h +symbol2str.o: Lpars.h +char.o: class.h Lpars.o: Lpars.h +casestat.o: LLlex.h +casestat.o: Lpars.h +casestat.o: debug.h +casestat.o: debugcst.h +casestat.o: density.h +casestat.o: desig.h +casestat.o: node.h +casestat.o: type.h +casestat.o: walk.h +tmpvar.o: debug.h +tmpvar.o: debugcst.h +tmpvar.o: def.h +tmpvar.o: main.h +tmpvar.o: scope.h +tmpvar.o: type.h +scope.o: LLlex.h +scope.o: debug.h +scope.o: debugcst.h +scope.o: def.h +scope.o: idf.h +scope.o: node.h +scope.o: scope.h +scope.o: type.h +next.o: debug.h +next.o: debugcst.h diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c index 500b98774..75e20d6a2 100644 --- a/lang/m2/comp/chk_expr.c +++ b/lang/m2/comp/chk_expr.c @@ -33,6 +33,7 @@ #include "warning.h" extern char *symbol2str(); +extern char *sprint(); STATIC Xerror(nd, mess, edf) @@ -293,7 +294,7 @@ ChkElement(expp, tp, set, level) register struct node *expr = *expp; register struct node *left = expr->nd_left; register struct node *right = expr->nd_right; - register int i; + register arith i; if (expr->nd_class == Link && expr->nd_symb == UPTO) { /* { ... , expr1 .. expr2, ... } @@ -310,7 +311,7 @@ ChkElement(expp, tp, set, level) */ if (left->nd_INT > right->nd_INT) { -node_error(expp, "lower bound exceeds upper bound in range"); +node_error(expr, "lower bound exceeds upper bound in range"); return 0; } @@ -385,7 +386,7 @@ ChkSet(expp) if (!is_type(df) || (df->df_type->tp_fund != T_SET)) { if (df->df_kind != D_ERROR) { - Xerror(expp, "not a set type", df); + Xerror(nd, "not a set type", df); } return 0; } @@ -571,6 +572,23 @@ ChkProcCall(expp) return retval; } +int +ChkFunCall(expp) + register struct node *expp; +{ + /* Check a call that must have a result + */ + int retval = 1; + + if (!ChkCall(expp)) retval = 0; + if (expp->nd_type == 0) { + node_error(expp, "function call expected"); + expp->nd_type = error_type; + retval = 0; + } + return retval; +} + int ChkCall(expp) register struct node *expp; @@ -1007,7 +1025,7 @@ ChkStandard(expp, left) tk->TOK_INT = PointedtoType(left->nd_type)->tp_size; tk->tk_symb = INTEGER; tk->tk_lineno = left->nd_lineno; - nd = MkLeaf(Value, &dt); + nd = MkLeaf(Value, tk); nd->nd_type = card_type; tk->tk_symb = ','; arg->nd_right = MkNode(Link, nd, NULLNODE, tk); @@ -1199,7 +1217,7 @@ int (*ExprChkTable[])() = { ChkBinOper, ChkUnOper, ChkArrow, - ChkCall, + ChkFunCall, ChkExLinkOrName, NodeCrash, ChkSet, diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c index f7afbae21..305d2c4fc 100644 --- a/lang/m2/comp/code.c +++ b/lang/m2/comp/code.c @@ -49,11 +49,9 @@ CodeConst(cst, size) else { crash("(CodeConst)"); /* - label dlab = ++data_label; - - C_df_dlb(dlab); + C_df_dlb(++data_label); C_rom_icon(long2str((long) cst), size); - C_lae_dlb(dlab, (arith) 0); + C_lae_dlb(data_label, (arith) 0); C_loi(size); */ } @@ -63,14 +61,13 @@ CodeString(nd) register struct node *nd; { if (nd->nd_type->tp_fund != T_STRING) { + /* Character constant */ C_loc(nd->nd_INT); } else { - label lab = ++data_label; - - C_df_dlb(lab); + C_df_dlb(++data_label); C_rom_scon(nd->nd_STR, WA(nd->nd_SLE + 1)); - C_lae_dlb(lab, (arith) 0); + C_lae_dlb(data_label, (arith) 0); } } @@ -100,11 +97,8 @@ CodeExpr(nd, ds, true_label, false_label) case Oper: CodeOper(nd, true_label, false_label); - if (true_label == 0) ds->dsg_kind = DSG_LOADED; - else { - ds->dsg_kind = DSG_INIT; - true_label = 0; - } + ds->dsg_kind = DSG_LOADED; + true_label = NO_LABEL; break; case Uoper: @@ -114,14 +108,11 @@ CodeExpr(nd, ds, true_label, false_label) case Value: switch(nd->nd_symb) { - case REAL: { - label lab = ++data_label; - - C_df_dlb(lab); + case REAL: + C_df_dlb(++data_label); C_rom_fcon(nd->nd_REL, nd->nd_type->tp_size); - C_lae_dlb(lab, (arith) 0); + C_lae_dlb(data_label, (arith) 0); C_loi(nd->nd_type->tp_size); - } break; case STRING: CodeString(nd); @@ -142,16 +133,11 @@ CodeExpr(nd, ds, true_label, false_label) case Xset: case Set: { - register arith *st = nd->nd_set; - register int i; + register int i = tp->tp_size / word_size; + register arith *st = nd->nd_set + i; - st = nd->nd_set; ds->dsg_kind = DSG_LOADED; - if (!st) { - C_zer(tp->tp_size); - break; - } - for (i = tp->tp_size / word_size, st += i; i > 0; i--) { + for (; i > 0; i--) { C_loc(*--st); } CodeSet(nd); @@ -162,11 +148,10 @@ CodeExpr(nd, ds, true_label, false_label) crash("(CodeExpr) bad node type"); } - if (true_label != 0) { + if (true_label != NO_LABEL) { /* Only for boolean expressions */ CodeValue(ds, tp->tp_size, tp->tp_align); - *ds = InitDesig; C_zne(true_label); C_bra(false_label); } @@ -304,10 +289,10 @@ CodeCall(nd) register struct def *df = left->nd_def; if (df->df_kind == D_PROCEDURE) { - arith level = df->df_scope->sc_level; + int level = df->df_scope->sc_level; if (level > 0) { - C_lxl((arith) proclevel - level); + C_lxl((arith) (proclevel - level)); } C_cal(NameOfProc(df)); break; @@ -321,7 +306,7 @@ CodeCall(nd) CodePExpr(left); C_cai(); } - if (left->nd_type->prc_nbpar) C_asp(left->nd_type->prc_nbpar); + C_asp(left->nd_type->prc_nbpar); if (result_tp = ResultType(left->nd_type)) { if (IsConstructed(result_tp)) { C_lfr(pointer_size); @@ -353,7 +338,7 @@ CodeParameters(param, arg) C_loc(tp->arr_elsize); if (IsConformantArray(left_type)) { - DoHIGH(left); + DoHIGH(left->nd_def); if (elem->tp_size != left_type->arr_elem->tp_size) { /* This can only happen if the formal type is ARRAY OF (WORD|BYTE) @@ -478,13 +463,13 @@ CodeStd(nd) case S_HIGH: assert(IsConformantArray(tp)); - DoHIGH(left); + DoHIGH(left->nd_def); break; case S_SIZE: case S_TSIZE: assert(IsConformantArray(tp)); - DoHIGH(left); + DoHIGH(left->nd_def); C_inc(); C_loc(tp->arr_elem->tp_size); C_mlu(word_size); @@ -777,7 +762,7 @@ CodeOper(expr, true_label, false_label) default: crash("bad type COMPARE"); } - if (true_label != 0) { + if (true_label != NO_LABEL) { compare(expr->nd_symb, true_label); C_bra(false_label); } @@ -794,7 +779,7 @@ CodeOper(expr, true_label, false_label) CodePExpr(leftop); CodeCoercion(leftop->nd_type, word_type); C_inn(rightop->nd_type->tp_size); - if (true_label != 0) { + if (true_label != NO_LABEL) { C_zne(true_label); C_bra(false_label); } @@ -806,7 +791,7 @@ CodeOper(expr, true_label, false_label) struct desig Des; int genlabels = 0; - if (true_label == 0) { + if (true_label == NO_LABEL) { genlabels = 1; true_label = ++text_label; false_label = ++text_label; @@ -1000,17 +985,15 @@ CodeDStore(nd) CodeStore(&designator, nd->nd_type->tp_size, nd->nd_type->tp_align); } -DoHIGH(nd) - struct node *nd; +DoHIGH(df) + register struct def *df; { /* Get the high index of a conformant array, indicated by "nd". The high index is the second field in the descriptor of the array, so it is easily found. */ - register struct def *df = nd->nd_def; register arith highoff; - assert(nd->nd_class == Def); assert(df->df_kind == D_VARIABLE); assert(IsConformantArray(df->df_type)); diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g index 229fcbf41..3a67f1a62 100644 --- a/lang/m2/comp/declar.g +++ b/lang/m2/comp/declar.g @@ -132,7 +132,7 @@ TypeDeclaration { struct def *df; struct type *tp; - struct node *nd; + register struct node *nd; }: IDENT { df = define(dot.TOK_IDF, CurrentScope, D_TYPE); nd = MkLeaf(Name, &dot); @@ -143,7 +143,7 @@ TypeDeclaration } ; -type(struct type **ptp;): +type(register struct type **ptp;): %default SimpleType(ptp) | ArrayType(ptp) @@ -157,7 +157,7 @@ type(struct type **ptp;): ProcedureType(ptp) ; -SimpleType(struct type **ptp;) +SimpleType(register struct type **ptp;) { struct type *tp; } : @@ -264,9 +264,9 @@ FieldListSequence(struct scope *scope; arith *cnt; int *palign;): FieldList(struct scope *scope; arith *cnt; int *palign;) { struct node *FldList; - register struct idf *id = 0; struct type *tp; struct node *nd; + register struct def *df; arith tcnt, max; } : [ @@ -288,7 +288,17 @@ FieldList(struct scope *scope; arith *cnt; int *palign;) { if (nd->nd_class != Name) { error("illegal variant tag"); } - else id = nd->nd_IDF; + else { + df = define(nd->nd_IDF, scope, D_FIELD); + *palign = lcm(*palign, tp->tp_align); + if (!(tp->tp_fund & T_DISCRETE)) { + error("illegal type in variant"); + } + df->df_type = tp; + df->fld_off = align(*cnt, tp->tp_align); + *cnt = df->fld_off + tp->tp_size; + df->df_flags |= D_QEXPORTED; + } FreeNode(nd); } | /* Old fashioned! the first qualident now represents @@ -302,22 +312,7 @@ FieldList(struct scope *scope; arith *cnt; int *palign;) | ':' qualtype(&tp) /* Aha, third edition. Well done! */ ] - { - *palign = lcm(*palign, tp->tp_align); - if (id) { - register struct def *df = - define(id, scope, D_FIELD); - - if (!(tp->tp_fund & T_DISCRETE)) { - error("illegal type in variant"); - } - df->df_type = tp; - df->fld_off = align(*cnt, tp->tp_align); - *cnt = df->fld_off + tp->tp_size; - df->df_flags |= D_QEXPORTED; - } - tcnt = *cnt; - } + { tcnt = *cnt; } OF variant(scope, &tcnt, tp, palign) { max = tcnt; tcnt = *cnt; } [ @@ -360,26 +355,26 @@ CaseLabelList(struct type **ptp; struct node **pnd;): CaseLabels(struct type **ptp; register struct node **pnd;) { - register struct node *nd1; + register struct node *nd; }: ConstExpression(pnd) - { nd1 = *pnd; } + { nd = *pnd; } [ - UPTO { *pnd = MkNode(Link,nd1,NULLNODE,&dot); } + UPTO { *pnd = MkNode(Link,nd,NULLNODE,&dot); } ConstExpression(&(*pnd)->nd_right) - { if (!TstCompat(nd1->nd_type, + { if (!TstCompat(nd->nd_type, (*pnd)->nd_right->nd_type)) { node_error((*pnd)->nd_right, "type incompatibility in case label"); - nd1->nd_type = error_type; + nd->nd_type = error_type; } } ]? - { if (*ptp != 0 && !TstCompat(*ptp, nd1->nd_type)) { - node_error(nd1, + { if (*ptp != 0 && !TstCompat(*ptp, nd->nd_type)) { + node_error(nd, "type incompatibility in case label"); } - *ptp = nd1->nd_type; + *ptp = nd->nd_type; } ; @@ -392,7 +387,7 @@ SetType(struct type **ptp;) : have to be declared yet, so be careful about identifying type-identifiers */ -PointerType(struct type **ptp;) : +PointerType(register struct type **ptp;) : POINTER TO [ %if (type_or_forward(ptp)) type(&((*ptp)->next)) @@ -409,7 +404,7 @@ qualtype(struct type **ptp;) { *ptp = qualified_type(nd); } ; -ProcedureType(struct type **ptp;) +ProcedureType(register struct type **ptp;) { struct paramlist *pr = 0; arith parmaddr = 0; @@ -423,18 +418,12 @@ ProcedureType(struct type **ptp;) { *ptp = proc_type(*ptp, pr, parmaddr); } ; -FormalTypeList(struct paramlist **ppr; arith *parmaddr; struct type **ptp;) -{ - struct type *tp; - int VARp; -} : +FormalTypeList(struct paramlist **ppr; arith *parmaddr; struct type **ptp;): '(' [ - var(&VARp) FormalType(&tp) - { EnterParamList(ppr,NULLNODE,tp,VARp,parmaddr); } + VarFormalType(ppr, parmaddr) [ - ',' var(&VARp) FormalType(&tp) - { EnterParamList(ppr,NULLNODE,tp,VARp,parmaddr); } + ',' VarFormalType(ppr, parmaddr) ]* ]? ')' @@ -442,10 +431,22 @@ FormalTypeList(struct paramlist **ppr; arith *parmaddr; struct type **ptp;) ]? ; -var(int *VARp;): - VAR { *VARp = D_VARPAR; } -| - /* empty */ { *VARp = D_VALPAR; } +VarFormalType(struct paramlist **ppr; arith *parmaddr;) +{ + struct type *tp; + int isvar; +} : + var(&isvar) + FormalType(&tp) + { EnterParamList(ppr,NULLNODE,tp,isvar,parmaddr); } +; + +var(int *VARp;) : + [ + VAR { *VARp = D_VARPAR; } + | + /* empty */ { *VARp = D_VALPAR; } + ] ; ConstantDeclaration diff --git a/lang/m2/comp/defmodule.c b/lang/m2/comp/defmodule.c index d402a7805..6b913327a 100644 --- a/lang/m2/comp/defmodule.c +++ b/lang/m2/comp/defmodule.c @@ -36,7 +36,7 @@ struct idf *DefId; STATIC char * getwdir(fn) - char *fn; + register char *fn; { register char *p; char *strrindex(); @@ -49,7 +49,7 @@ getwdir(fn) if (p) { *p = '\0'; - fn = Salloc(fn, p - &fn[0] + 1); + fn = Salloc(fn, (unsigned) (p - &fn[0] + 1)); *p = '/'; return fn; } @@ -64,7 +64,7 @@ GetFile(name) in the directories mentioned in "DEFPATH". */ char buf[15]; - char *strcpy(), *strcat(); + char *strncpy(), *strcat(); static char *WorkingDir = "."; strncpy(buf, name, 10); diff --git a/lang/m2/comp/desig.c b/lang/m2/comp/desig.c index d04ccf19f..63da0249c 100644 --- a/lang/m2/comp/desig.c +++ b/lang/m2/comp/desig.c @@ -67,7 +67,6 @@ CodeValue(ds, size, al) /* Generate code to load the value of the designator described in "ds" */ - arith tmp = 0; switch(ds->dsg_kind) { case DSG_LOADED: @@ -100,14 +99,16 @@ CodeValue(ds, size, al) break; } if (ds->dsg_kind == DSG_PLOADED) { - tmp = NewPtr(); - C_stl(tmp); + arith sz = WA(size) - pointer_size; + + C_asp(-sz); + C_lor((arith) 1); + C_adp(sz); + C_loi(pointer_size); } - C_asp(-WA(size)); - if (!tmp) CodeAddress(ds); - else { - C_lol(tmp); - FreePtr(tmp); + else { + C_asp(-WA(size)); + CodeAddress(ds); } C_loc(size); C_cal("_load"); @@ -300,6 +301,7 @@ CodeMove(rhs, left, rtp) } { arith tmp; + extern arith NewPtr(); if (loadedflag) { tmp = NewPtr(); diff --git a/lang/m2/comp/main.c b/lang/m2/comp/main.c index 427fb241d..9019d634d 100644 --- a/lang/m2/comp/main.c +++ b/lang/m2/comp/main.c @@ -14,6 +14,7 @@ #include #include #include +#include #include "input.h" #include "f_info.h" @@ -101,7 +102,7 @@ Compile(src, dst) C_ms_emx(word_size, pointer_size); CheckForLineDirective(); CompUnit(); - C_ms_src((arith) (LineNumber - 1), FileName); + C_ms_src((int)LineNumber - 1, FileName); if (!err_occurred) { C_exp(Defined->mod_vis->sc_scope->sc_name); WalkModule(Defined); diff --git a/lang/m2/comp/options.c b/lang/m2/comp/options.c index 6bcf3d164..174206112 100644 --- a/lang/m2/comp/options.c +++ b/lang/m2/comp/options.c @@ -13,6 +13,7 @@ #include #include +#include #include "type.h" #include "main.h" @@ -117,7 +118,7 @@ DoOption(text) if (++nDEF > mDEF) { char **n = (char **) - Malloc((10+mDEF)*sizeof(char *)); + Malloc((unsigned)((10+mDEF)*sizeof(char *))); for (i = 0; i < mDEF; i++) { n[i] = DEFPATH[i]; diff --git a/lang/m2/comp/program.g b/lang/m2/comp/program.g index 034ff445d..e6852401a 100644 --- a/lang/m2/comp/program.g +++ b/lang/m2/comp/program.g @@ -66,10 +66,7 @@ ModuleDeclaration } ; -priority(register struct def *df;) -{ - register struct node *nd; -} : +priority(register struct def *df;): [ '[' ConstExpression(&(df->mod_priority)) ']' { if (!(df->mod_priority->nd_type->tp_fund & diff --git a/lang/m2/comp/scope.C b/lang/m2/comp/scope.C index 337feefa8..8f0b6534c 100644 --- a/lang/m2/comp/scope.C +++ b/lang/m2/comp/scope.C @@ -60,7 +60,7 @@ open_and_close_scope(scopetype) open_scope(scopetype); sc = CurrentScope; - close_scope(); + close_scope(0); return sc; } @@ -106,7 +106,7 @@ chk_proc(df) STATIC chk_forw(pdf) - register struct def **pdf; + struct def **pdf; { /* Called at scope close. Look for all forward definitions and if the scope was a closed scope, give an error message for @@ -197,6 +197,7 @@ Reverse(pdf) } close_scope(flag) + register int flag; { /* Close a scope. If "flag" is set, check for forward declarations, either POINTER declarations, or EXPORTs, or forward references diff --git a/lang/m2/comp/tokenname.c b/lang/m2/comp/tokenname.c index c78f50bd9..cbf7c8413 100644 --- a/lang/m2/comp/tokenname.c +++ b/lang/m2/comp/tokenname.c @@ -20,6 +20,7 @@ Also, the "token2str.c" file is produced from this file. */ +#ifdef ___XXX___ struct tokenname tkspec[] = { /* the names of the special tokens */ {IDENT, "identifier"}, {STRING, "string"}, @@ -35,6 +36,7 @@ struct tokenname tkcomp[] = { /* names of the composite tokens */ {BECOMES, ":="}, {0, ""} }; +#endif struct tokenname tkidf[] = { /* names of the identifier tokens */ {AND, "AND"}, @@ -80,6 +82,7 @@ struct tokenname tkidf[] = { /* names of the identifier tokens */ {0, ""} }; +#ifdef ___XXX___ struct tokenname tkinternal[] = { /* internal keywords */ {PROGRAM, ""}, {0, "0"} @@ -88,6 +91,7 @@ struct tokenname tkinternal[] = { /* internal keywords */ struct tokenname tkstandard[] = { /* standard identifiers */ {0, ""} }; +#endif /* Some routines to handle tokennames */ diff --git a/lang/m2/comp/type.H b/lang/m2/comp/type.H index 9bca0e904..06cc533c5 100644 --- a/lang/m2/comp/type.H +++ b/lang/m2/comp/type.H @@ -12,7 +12,7 @@ struct paramlist { /* structure for parameterlist of a PROCEDURE */ struct paramlist *next; struct def *par_def; /* "df" of parameter */ -#define IsVarParam(xpar) ((xpar)->par_def->df_flags & D_VARPAR) +#define IsVarParam(xpar) ((int) ((xpar)->par_def->df_flags & D_VARPAR)) #define TypeOfParam(xpar) ((xpar)->par_def->df_type) }; diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c index b9eb03ced..9afdc889a 100644 --- a/lang/m2/comp/type.c +++ b/lang/m2/comp/type.c @@ -217,7 +217,7 @@ u_small(tp, n) tp->tp_size = 1; tp->tp_align = 1; } - else if (ufit(n, short_size)) { + else if (ufit(n, (int)short_size)) { tp->tp_size = short_size; tp->tp_align = short_align; } @@ -302,16 +302,18 @@ chk_basesubrange(tp, base) struct type * subr_type(lb, ub) - struct node *lb, *ub; + register struct node *lb; + struct node *ub; { /* Construct a subrange type from the constant expressions indicated by "lb" and "ub", but first perform some checks */ - register struct type *tp = BaseType(lb->nd_type), *res; + register struct type *tp = BaseType(lb->nd_type); + register struct type *res; if (!TstCompat(lb->nd_type, ub->nd_type)) { - node_error(ub, "types of subrange bounds not equal"); + node_error(lb, "types of subrange bounds not equal"); return error_type; } @@ -326,14 +328,14 @@ subr_type(lb, ub) /* Check base type */ if (! (tp->tp_fund & T_DISCRETE)) { - node_error(ub, "illegal base type for subrange"); + node_error(lb, "illegal base type for subrange"); return error_type; } /* Check bounds */ if (lb->nd_INT > ub->nd_INT) { - node_error(ub, "lower bound exceeds upper bound"); + node_error(lb, "lower bound exceeds upper bound"); } /* Now construct resulting type @@ -351,8 +353,8 @@ subr_type(lb, ub) res->tp_size = 1; res->tp_align = 1; } - else if (fit(res->sub_lb, short_size) && - fit(res->sub_ub, short_size)) { + else if (fit(res->sub_lb, (int)short_size) && + fit(res->sub_ub, (int)short_size)) { res->tp_size = short_size; res->tp_align = short_align; } @@ -381,22 +383,19 @@ genrck(tp) */ arith lb, ub; register label ol; - int newlabel = 0; getbounds(tp, &lb, &ub); if (tp->tp_fund == T_SUBRANGE) { if (!(ol = tp->sub_rck)) { - tp->sub_rck = ol = ++data_label; - newlabel = 1; + tp->sub_rck = ++data_label; } } else if (!(ol = tp->enm_rck)) { - tp->enm_rck = ol = ++data_label; - newlabel = 1; + tp->enm_rck = ++data_label; } - if (newlabel) { - C_df_dlb(ol); + if (!ol) { + C_df_dlb(ol = data_label); C_rom_cst(lb); C_rom_cst(ub); } @@ -571,18 +570,21 @@ int type_or_forward(ptp) struct type **ptp; { - struct node *nd = 0; + /* POINTER TO IDENTIFIER construction. The IDENTIFIER resides + in "dot". This routine handles the different cases. + */ + register struct node *nd; *ptp = construct_type(T_POINTER, NULLTYPE); - if (lookup(dot.TOK_IDF, CurrentScope, 1) + if (lookup(dot.TOK_IDF, CurrentScope, 1)) { /* Either a Module or a Type, but in both cases defined in this scope, so this is the correct identification */ - || - ( nd = new_node(), - nd->nd_token = dot, - lookfor(nd, CurrVis, 0)->df_kind == D_MODULE - ) + return 1; + } + nd = new_node(); + nd->nd_token = dot; + if (lookfor(nd, CurrVis, 0)->df_kind == D_MODULE) { /* A Modulename in one of the enclosing scopes. It is not clear from the language definition that it is correct to handle these like this, but @@ -591,8 +593,7 @@ type_or_forward(ptp) one token. ??? */ - ) { - if (nd) free_node(nd); + free_node(nd); return 1; } /* Enter a forward reference into a list belonging to the @@ -652,7 +653,7 @@ DumpType(tp) switch(tp->tp_fund) { case T_RECORD: print("RECORD\n"); - DumpScope(tp->rec_scope); + DumpScope(tp->rec_scope->sc_def); break; case T_ENUMERATION: print("ENUMERATION; ncst:%d", tp->enm_ncst); break; diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c index f8328455e..f64ac4070 100644 --- a/lang/m2/comp/walk.c +++ b/lang/m2/comp/walk.c @@ -75,15 +75,14 @@ DoProfil() static label filename_label = 0; if (! options['L']) { - register label fn_label = filename_label; - if (!fn_label) { - filename_label = fn_label = ++data_label; - C_df_dlb(fn_label); + if (!filename_label) { + filename_label = ++data_label; + C_df_dlb(filename_label); C_rom_scon(FileName, (arith) (strlen(FileName) + 1)); } - C_fil_dlb(fn_label, (arith) 0); + C_fil_dlb(filename_label, (arith) 0); } } @@ -126,16 +125,14 @@ WalkModule(module) /* We don't actually prevent recursive calls, but do nothing if called recursively */ - label l1 = ++data_label; - - C_df_dlb(l1); - C_bss_cst(word_size, (arith) 0, 1); + C_df_dlb(++data_label); + C_con_cst((arith) 0); /* if this one is set to non-zero, the initialization was already done. */ - C_loe_dlb(l1, (arith) 0); + C_loe_dlb(data_label, (arith) 0); C_zne(RETURN_LABEL); - C_ine_dlb(l1, (arith) 0); + C_ine_dlb(data_label, (arith) 0); } for (; nd; nd = nd->next) {