many minor corrections
authorceriel <none@none>
Mon, 18 May 1987 15:57:33 +0000 (15:57 +0000)
committerceriel <none@none>
Mon, 18 May 1987 15:57:33 +0000 (15:57 +0000)
15 files changed:
lang/m2/comp/LLlex.c
lang/m2/comp/Makefile
lang/m2/comp/chk_expr.c
lang/m2/comp/code.c
lang/m2/comp/declar.g
lang/m2/comp/defmodule.c
lang/m2/comp/desig.c
lang/m2/comp/main.c
lang/m2/comp/options.c
lang/m2/comp/program.g
lang/m2/comp/scope.C
lang/m2/comp/tokenname.c
lang/m2/comp/type.H
lang/m2/comp/type.c
lang/m2/comp/walk.c

index 03bf5bf..3c6a047 100644 (file)
@@ -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;
 
index bf27961..fb1d9ee 100644 (file)
@@ -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
index 500b987..75e20d6 100644 (file)
@@ -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,
index f7afbae..305d2c4 100644 (file)
@@ -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));
 
index 229fcbf..3a67f1a 100644 (file)
@@ -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
index d402a78..6b91332 100644 (file)
@@ -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);
index d04ccf1..63da024 100644 (file)
@@ -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();
index 427fb24..9019d63 100644 (file)
@@ -14,6 +14,7 @@
 #include       <system.h>
 #include       <em_arith.h>
 #include       <em_label.h>
+#include       <alloc.h>
 
 #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);
index 6bcf3d1..1742061 100644 (file)
@@ -13,6 +13,7 @@
 
 #include       <em_arith.h>
 #include       <em_label.h>
+#include       <alloc.h>
 
 #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];
index 034ff44..e685240 100644 (file)
@@ -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 &
index 337feef..8f0b653 100644 (file)
@@ -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
index c78f50b..cbf7c84 100644 (file)
@@ -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 */
 
index 9bca0e9..06cc533 100644 (file)
@@ -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)
 };
 
index b9eb03c..9afdc88 100644 (file)
@@ -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;
index f832845..f64ac40 100644 (file)
@@ -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) {