newer version
authorceriel <none@none>
Fri, 6 Jun 1986 02:22:09 +0000 (02:22 +0000)
committerceriel <none@none>
Fri, 6 Jun 1986 02:22:09 +0000 (02:22 +0000)
17 files changed:
lang/m2/comp/LLlex.c
lang/m2/comp/chk_expr.c
lang/m2/comp/code.c
lang/m2/comp/cstoper.c
lang/m2/comp/declar.g
lang/m2/comp/def.c
lang/m2/comp/defmodule.c
lang/m2/comp/desig.c
lang/m2/comp/enter.c
lang/m2/comp/expression.g
lang/m2/comp/input.c
lang/m2/comp/main.c
lang/m2/comp/program.g
lang/m2/comp/scope.C
lang/m2/comp/standards.h
lang/m2/comp/type.c
lang/m2/comp/walk.c

index e4a15ab..1f87f78 100644 (file)
@@ -29,7 +29,6 @@ struct token dot, aside;
 struct type *toktype;
 struct string string;
 int idfsize = IDFSIZE;
-extern label   data_label();
 
 static
 SkipComment()
@@ -51,21 +50,15 @@ SkipComment()
                        if (ch == '*') {
                                ++NestLevel;
                        }
-                       else {
-                               continue;
-                       }
+                       else    continue;
                }
                else
                if (ch == '*') {
                        LoadChar(ch);
                        if (ch == ')') {
-                               if (NestLevel-- == 0) {
-                                       return;
-                               }
-                       }
-                       else {
-                               continue;
+                               if (NestLevel-- == 0) return;
                        }
+                       else    continue;
                }
                LoadChar(ch);
        }
@@ -198,7 +191,7 @@ again:
                        return tk->tk_symb = ch;
 
                default :
-                       assert(0);
+                       crash("(LLlex, STCOMP)");
                }
 
        case STIDF:
@@ -216,7 +209,6 @@ again:
                *tg++ = '\0';
 
                tk->TOK_IDF = id = str2idf(buf, 1);
-               if (!id) fatal("Out of memory");
                return tk->tk_symb = id->id_reserved ? id->id_reserved : IDENT;
        }
 
@@ -413,7 +405,7 @@ Sdec:
 
        case STCHAR:
        default:
-               assert(0);
+               crash("(LLlex) Impossible character class");
        }
        /*NOTREACHED*/
 }
index 49163d6..6fed177 100644 (file)
@@ -68,15 +68,34 @@ chk_expr(expp)
        case Xset:
                return chk_set(expp);
 
+       case Link:
        case Name:
-               return chk_designator(expp, VALUE, D_USED);
+               if (chk_designator(expp, VALUE|DESIGNATOR, D_USED)) {
+                       if (expp->nd_class == Def &&
+                           expp->nd_def->df_kind == D_PROCEDURE) {
+                               /* Check that this procedure is one that we
+                                  may take the address from.
+                               */
+                               if (expp->nd_def->df_type == std_type) {
+                                       /* Standard procedure. Illegal */
+node_error(expp, "address of standard procedure taken");
+                                       return 0;
+                               }
+                               if (expp->nd_def->df_scope->sc_level > 0) {
+                                       /* Address of nested procedure taken.
+                                          Illegal.
+                                       */
+node_error(expp, "address of a procedure local to another one taken");
+                                       return 0;
+                               }
+                       }
+                       return 1;
+               }
+               return 0;
 
        case Call:
                return chk_call(expp);
 
-       case Link:
-               return chk_designator(expp, DESIGNATOR|VALUE, D_USED|D_NOREG);
-
        default:
                crash("(chk_expr)");
        }
@@ -312,7 +331,6 @@ chk_call(expp)
                it may also be a cast or a standard procedure call.
        */
        register struct node *left;
-       register struct node *arg;
 
        /* First, get the name of the function or procedure
        */
@@ -340,7 +358,8 @@ chk_call(expp)
                */
                return chk_proccall(expp);
        }
-       node_error(expp->nd_left, "procedure, type, or function expected");
+
+       node_error(left, "procedure, type, or function expected");
        return 0;
 }
 
@@ -420,7 +439,7 @@ FlagCheck(expp, df, flag)
        }
 
        if ((flag & VALUE) &&
-           ( !(df->df_kind & (D_VARIABLE|D_FIELD|D_CONST|D_ENUM)))) {
+           ( !(df->df_kind & (D_VARIABLE|D_FIELD|D_CONST|D_ENUM|D_PROCEDURE)))) {
                node_error(expp, "value expected");
                return 0;
        }
@@ -584,6 +603,62 @@ symbol2str(expp->nd_symb));
        return 0;
 }
 
+struct type *
+ResultOfOperation(operator, tp)
+       struct type *tp;
+{
+       switch(operator) {
+       case '=':
+       case '#':
+       case GREATEREQUAL:
+       case LESSEQUAL:
+       case '<':
+       case '>':
+       case IN:
+               return bool_type;
+       }
+
+       return tp;
+}
+
+int
+Boolean(operator)
+{
+       return operator == OR || operator == AND || operator == '&';
+}
+
+int
+AllowedTypes(operator)
+{
+       switch(operator) {
+       case '+':
+       case '-':
+       case '*':
+               return T_NUMERIC|T_SET;
+       case '/':
+               return T_REAL|T_SET;
+       case DIV:
+       case MOD:
+               return T_INTORCARD;
+       case OR:
+       case AND:
+       case '&':
+               return T_ENUMERATION;
+       case '=':
+       case '#':
+               return T_POINTER|T_HIDDEN|T_SET|T_NUMERIC|T_ENUMERATION|T_CHAR;
+       case GREATEREQUAL:
+       case LESSEQUAL:
+               return T_SET|T_NUMERIC|T_CHAR|T_ENUMERATION;
+       case '<':
+       case '>':
+               return T_NUMERIC|T_CHAR|T_ENUMERATION;
+       default:
+               crash("(AllowedTypes)");
+       }
+       /*NOTREACHED*/
+}
+
 int
 chk_oper(expp)
        register struct node *expp;
@@ -594,8 +669,11 @@ chk_oper(expp)
        register struct node *right = expp->nd_right;
        struct type *tpl = left->nd_type;
        struct type *tpr = right->nd_type;
-       int errval = 1;
-       
+       int allowed;
+
+       if (tpl->tp_fund == T_SUBRANGE) tpl = tpl->next;
+       if (tpr->tp_fund == T_SUBRANGE) tpr = tpr->next;
+
        if (tpl == intorcard_type) {
                if (tpr == int_type || tpr == card_type) {
                         left->nd_type = tpl = tpr;
@@ -606,11 +684,11 @@ chk_oper(expp)
                        right->nd_type = tpr = tpl;
                }
        }
-       expp->nd_type = error_type;
+
+       expp->nd_type = ResultOfOperation(expp->nd_symb, tpl);
 
        if (expp->nd_symb == IN) {
                /* Handle this one specially */
-               expp->nd_type = bool_type;
                if (tpr->tp_fund != T_SET) {
 node_error(expp, "RHS of IN operator not a SET type");
                        return 0;
@@ -630,9 +708,6 @@ node_error(expp, "IN operator: type of LHS not compatible with element type of R
                return 1;
        }
 
-       if (tpl->tp_fund == T_SUBRANGE) tpl = tpl->next;
-       expp->nd_type = tpl;
-
        /* Operands must be compatible (distilled from Def 8.2)
        */
        if (!TstCompat(tpl, tpr)) {
@@ -641,128 +716,28 @@ node_error(expp, "IN operator: type of LHS not compatible with element type of R
                return 0;
        }
 
-       switch(expp->nd_symb) {
-       case '+':
-       case '-':
-       case '*':
-               switch(tpl->tp_fund) {
-               case T_POINTER:
-                       if (! chk_address(tpl, tpr)) break;
-                       /* Fall through */
-               case T_INTEGER:
-               case T_CARDINAL:
-               case T_INTORCARD:
-                       if (left->nd_class==Value && right->nd_class==Value) {
-                               cstbin(expp);
-                       }
-                       return 1;
-
-               case T_SET:
-                       if (left->nd_class == Set && right->nd_class == Set) {
-                               cstset(expp);
-                       }
-                       /* Fall through */
-
-               case T_REAL:
-                       return 1;
-               }
-               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
index ca72031..4566bc3 100644 (file)
@@ -27,6 +27,7 @@ extern label  text_label();
 extern char    *long2str();
 extern char    *symbol2str();
 extern int     proclevel;
+int            fp_used;
 
 CodeConst(cst, size)
        arith cst, size;
@@ -43,7 +44,7 @@ CodeConst(cst, size)
        }
        else {
                C_df_dlb(dlab = data_label());
-               C_rom_icon(long2str((long) cst), 10);
+               C_rom_icon(long2str((long) cst), size);
                C_lae_dlb(dlab, (arith) 0);
                C_loi(size);
        }
@@ -59,7 +60,7 @@ CodeString(nd)
        }
        else {
                C_df_dlb(lab = data_label());
-               C_rom_scon(nd->nd_STR, align(nd->nd_SLE + 1, word_size));
+               C_rom_scon(nd->nd_STR, align(nd->nd_SLE + 1, (int) word_size));
                C_lae_dlb(lab, (arith) 0);
        }
 }
@@ -80,11 +81,8 @@ CodePadString(nd, sz)
                assert(sizearg < sz);
                C_zer(sz - sizearg);
        }
-       C_asp(-sizearg);        /* room for string */
        CodeString(nd);         /* push address of string */
-       C_lor((arith) 1);       /* load stack pointer */
-       C_adp(pointer_size);    /* and compute target address from it */
-       C_blm(sizearg);         /* and copy */
+       C_loi(sizearg);
 }
 
 CodeReal(nd)
@@ -103,7 +101,9 @@ CodeExpr(nd, ds, true_label, false_label)
        register struct desig *ds;
        label true_label, false_label;
 {
+       register struct type *tp = nd->nd_type;
 
+       if (tp->tp_fund == T_REAL) fp_used = 1;
        switch(nd->nd_class) {
        case Def:
                if (nd->nd_def->df_kind == D_PROCEDURE) {
@@ -147,7 +147,7 @@ CodeExpr(nd, ds, true_label, false_label)
                        CodeString(nd);
                        break;
                case INTEGER:
-                       CodeConst(nd->nd_INT, nd->nd_type->tp_size);
+                       CodeConst(nd->nd_INT, tp->tp_size);
                        break;
                default:
                        crash("Value error");
@@ -167,12 +167,10 @@ CodeExpr(nd, ds, true_label, false_label)
                st = nd->nd_set;
                ds->dsg_kind = DSG_LOADED;
                if (!st) {
-                       C_zer(nd->nd_type->tp_size);
+                       C_zer(tp->tp_size);
                        break;
                }
-               for (i = nd->nd_type->tp_size / word_size, st += i;
-                    i > 0;
-                    i--) { 
+               for (i = tp->tp_size / word_size, st += i; i > 0; i--) { 
                        C_loc(*--st);
                }
                }
@@ -188,7 +186,7 @@ CodeExpr(nd, ds, true_label, false_label)
        }
 
        if (true_label != 0) {
-               CodeValue(ds, nd->nd_type->tp_size);
+               CodeValue(ds, tp->tp_size);
                *ds = InitDesig;
                C_zne(true_label);
                C_bra(false_label);
@@ -250,12 +248,12 @@ CodeCoercion(t1, t2)
                        }
                        break;
                case T_INTEGER:
-                       C_loc(t1->tp_size);
+                       C_loc(word_size);
                        C_loc(t2->tp_size);
                        C_cui();
                        break;
                case T_REAL:
-                       C_loc(t1->tp_size);
+                       C_loc(word_size);
                        C_loc(t2->tp_size);
                        C_cuf();
                        break;
@@ -322,41 +320,44 @@ CodeCall(nd)
                tp = TypeOfParam(param);
                arg = arg->nd_right;
                assert(arg != 0);
+               left = arg->nd_left;
                if (IsConformantArray(tp)) {
                        C_loc(tp->arr_elsize);
-                       if (IsConformantArray(arg->nd_left->nd_type)) {
-                               DoHIGH(arg->nd_left);
+                       if (IsConformantArray(left->nd_type)) {
+                               DoHIGH(left);
                        }
-                       else if (arg->nd_left->nd_symb == STRING) {
-                               C_loc(arg->nd_left->nd_SLE);
+                       else if (left->nd_symb == STRING) {
+                               C_loc(left->nd_SLE);
                        }
                        else if (tp->arr_elem == word_type) {
-                               C_loc(arg->nd_left->nd_type->tp_size / word_size - 1);
+                               C_loc(left->nd_type->tp_size / word_size - 1);
                        }
-                       else    C_loc(arg->nd_left->nd_type->tp_size /
+                       else    C_loc(left->nd_type->tp_size /
                                      tp->arr_elsize - 1);
-                       C_loc(0);
-                       if (arg->nd_left->nd_symb == STRING) {
-                               CodeString(arg->nd_left);
+                       C_loc((arith) 0);
+                       if (left->nd_symb == STRING) {
+                               CodeString(left);
                        }
-                       else    CodeDAddress(arg->nd_left);
+                       else    CodeDAddress(left);
                        pushed += pointer_size + 3 * word_size;
                }
                else if (IsVarParam(param)) {
-                       CodeDAddress(arg->nd_left);
+                       CodeDAddress(left);
                        pushed += pointer_size;
                }
                else {
-                       if (arg->nd_left->nd_type->tp_fund == T_STRING) {
-                               CodePadString(arg->nd_left,
+                       if (left->nd_type->tp_fund == T_STRING) {
+                               CodePadString(left,
                                              align(tp->tp_size, word_align));
                        }
-                       else CodePExpr(arg->nd_left);
-                       CheckAssign(arg->nd_left->nd_type, tp);
+                       else CodePExpr(left);
+                       CheckAssign(left->nd_type, tp);
                        pushed += align(tp->tp_size, word_align);
                }
        }
 
+       left = nd->nd_left;
+
        if (left->nd_class == Def && left->nd_def->df_kind == D_PROCEDURE) {
                if (left->nd_def->df_scope->sc_level > 0) {
                        C_lxl((arith) proclevel - left->nd_def->df_scope->sc_level);
@@ -944,15 +945,13 @@ CodeSet(nd)
 {
        struct type *tp = nd->nd_type;
 
+       C_zer(nd->nd_type->tp_size);    /* empty set */
        nd = nd->nd_right;
        while (nd) {
                assert(nd->nd_class == Link && nd->nd_symb == ',');
 
                CodeEl(nd->nd_left, tp);
                nd = nd->nd_right;
-               if (nd) {
-                       C_ior(tp->tp_size);
-               }
        }
 }
 
@@ -962,19 +961,19 @@ CodeEl(nd, tp)
 {
 
        if (nd->nd_class == Link && nd->nd_symb == UPTO) {
-               C_zer(tp->tp_size);     /* empty set */
-               C_lor((arith) 1);       /* SP: address of set */
+               C_loc(tp->tp_size);     /* push size */
                if (tp->next->tp_fund == T_SUBRANGE) {
                        C_loc(tp->next->sub_ub);
                }
-               else    C_loc(tp->next->enm_ncst - 1);
+               else    C_loc((arith) (tp->next->enm_ncst - 1));
                Operands(nd->nd_left, nd->nd_right);
                C_cal("_LtoUset");      /* library routine to fill set */
-               C_asp(2 * word_size + pointer_size);
+               C_asp(4 * word_size);
        }
        else {
                CodePExpr(nd);
                C_set(tp->tp_size);
+               C_ior(tp->tp_size);
        }
 }
 
index 7c0453a..617ef95 100644 (file)
@@ -39,6 +39,9 @@ cstunary(expp)
                break;
        case '-':
                o1 = -o1;
+               if (expp->nd_type->tp_fund == T_INTORCARD) {
+                       expp->nd_type = int_type;
+               }
                break;
        case NOT:
        case '~':
@@ -149,6 +152,9 @@ cstbin(expp)
 
        case '-':
                o1 -= o2;
+               if (expp->nd_type->tp_fund == T_INTORCARD) {
+                       if (o1 < 0) expp->nd_type = int_type;
+               }
                break;
 
        case '<':
index 84174ed..a0f8710 100644 (file)
@@ -22,7 +22,6 @@ static char *RcsId = "$Header$";
 #include       "main.h"
 
 int            proclevel = 0;  /* nesting level of procedures */
-extern char    *sprint();
 }
 
 ProcedureDeclaration
@@ -566,23 +565,22 @@ ConstantDeclaration
 VariableDeclaration
 {
        struct node *VarList;
+       register struct node *nd;
        struct type *tp;
 } :
-       IdentAddrList(&VarList)
+       IdentAddr(&VarList)
+                       { nd = VarList; }
+       [
+               ',' IdentAddr(&(nd->nd_right))
+                       { nd = nd->nd_right; }
+       ]*
        ':' type(&tp)
                        { EnterVarList(VarList, tp, proclevel > 0);
                          FreeNode(VarList);
                        }
 ;
 
-IdentAddrList(struct node **pnd;)
-{
-} :
+IdentAddr(struct node **pnd;) :
        IDENT           { *pnd = MkLeaf(Name, &dot); }
-       ConstExpression(&(*pnd)->nd_left)?
-       [               { pnd = &((*pnd)->nd_right); }
-               ',' IDENT
-                       { *pnd = MkLeaf(Name, &dot); }
-               ConstExpression(&(*pnd)->nd_left)?
-       ]*
+       ConstExpression(&((*pnd)->nd_left))?
 ;
index 80bc6ea..6f3344e 100644 (file)
@@ -390,11 +390,12 @@ idn->nd_IDF->id_text);
                        else if (!(df = lookup(ids->nd_IDF, vis->sc_scope))) {
 node_error(ids, "identifier \"%s\" not declared in qualifying module",
 ids->nd_IDF->id_text);
-                               df = ill_df;
+                               df = define(ids->nd_IDF,vis->sc_scope,D_ERROR);
                        }
                        else if (!(df->df_flags&(D_EXPORTED|D_QEXPORTED))) {
 node_error(ids,"identifier \"%s\" not exported from qualifying module",
 ids->nd_IDF->id_text);
+                               df->df_flags |= D_QEXPORTED;
                        }
                }
                else {
@@ -459,9 +460,8 @@ DeclProc(type)
                Also create a name for it.
        */
        register struct def *df;
-       static int nmcount = 0;
-       extern char *strcpy();
        extern char *sprint();
+       static int nmcount;
        char buf[256];
 
        assert(type & (D_PROCEDURE | D_PROCHEAD));
@@ -472,8 +472,7 @@ DeclProc(type)
                df = define(dot.TOK_IDF, CurrentScope, type);
                df->for_node = MkLeaf(Name, &dot);
                sprint(buf,"%s_%s",CurrentScope->sc_name,df->df_idf->id_text);
-               df->for_name = Malloc((unsigned) (strlen(buf)+1));
-               strcpy(df->for_name, buf);
+               df->for_name = Salloc(buf, (unsigned) (strlen(buf)+1));
                C_exp(df->for_name);
                open_scope(OPENSCOPE);
        }
@@ -491,16 +490,11 @@ DeclProc(type)
                }
                else {
                        df = define(dot.TOK_IDF, CurrentScope, type);
-                       if (CurrVis != Defined->mod_vis) {
-                               sprint(buf, "_%d_%s", ++nmcount,
-                                       df->df_idf->id_text);
-                       }
-                       else    sprint(buf, "%s_%s",CurrentScope->sc_name,
-                                               df->df_idf->id_text);
                        open_scope(OPENSCOPE);
                        df->prc_vis = CurrVis;
-                       CurrentScope->sc_name = Malloc((unsigned)(strlen(buf)+1));
-                       strcpy(CurrentScope->sc_name, buf);
+                       sprint(buf,"_%d_%s",++nmcount,df->df_idf->id_text);
+                       CurrentScope->sc_name = 
+                               Salloc(buf, (unsigned)(strlen(buf)+1));
                        C_inp(buf);
                }
        }
index fe6d63c..1696fac 100644 (file)
@@ -31,11 +31,9 @@ GetFile(name)
        char buf[256];
        char *strcpy(), *strcat();
 
-       (void) strcpy(buf, name);
-       if (strlen(buf) > 10) {
-               (void) strcpy(&buf[10], ".def");
-       }
-       else    (void) strcat(buf, ".def");
+       strcpy(buf, name);
+       buf[10] = '\0';                 /* maximum length */
+       strcat(buf, ".def");
        if (! InsertFile(buf, DEFPATH, &(FileName))) {
                fatal("Could'nt find a DEFINITION MODULE for \"%s\"", name);
        }
@@ -80,11 +78,3 @@ GetDefinitionModule(id)
        level--;
        return df;
 }
-
-AtEoIF()
-{
-       /*      Make the unstacking of input streams noticable by the
-               lexical analyzer
-       */
-       return 1;
-}
index 47780bf..69eb62b 100644 (file)
@@ -246,19 +246,6 @@ CodeVarDesig(df, ds)
                df->df_flags |= D_NOREG;
                return;
        }
-       
-       if (sc->sc_level == 0) {
-               /* the variable is global, but declared in a module local
-                  to the implementation or program module.
-                  Such variables can be accessed through an offset from
-                  the name of the module.
-               */
-               ds->dsg_name = &(sc->sc_name[1]);
-               ds->dsg_offset = df->var_off;
-               ds->dsg_kind = DSG_FIXED;
-               df->df_flags |= D_NOREG;
-               return;
-       }
 
        if (sc->sc_level != proclevel) {
                /* the variable is local to a statically enclosing procedure.
@@ -349,7 +336,7 @@ CodeDesig(nd, ds)
 
                        df = nd->nd_left->nd_def;
                        if (proclevel > df->df_scope->sc_level) {
-                               C_lxa(proclevel - df->df_scope->sc_level);
+                               C_lxa((arith) (proclevel - df->df_scope->sc_level));
                                C_adp(df->var_off + pointer_size);
                        }
                        else    C_lal(df->var_off + pointer_size);
index b2bb3bf..424c423 100644 (file)
@@ -118,7 +118,7 @@ EnterVarList(IdList, type, local)
        register struct def *df;
        register struct scopelist *sc;
        char buf[256];
-       extern char *sprint(), *Malloc(), *strcpy();
+       extern char *sprint();
 
        sc = CurrVis;
 
@@ -151,24 +151,12 @@ node_error(IdList->nd_left,"Illegal type for address");
                                                type->tp_align);
                        df->var_off = sc->sc_scope->sc_off;
                }
-               else if (!DefinitionModule && CurrVis != Defined->mod_vis) {    
-                       /* variable list belongs to an internal global
-                          module.
-                          Align offset and add size
-                       */
-                       sc->sc_scope->sc_off =
-                               align(sc->sc_scope->sc_off, type->tp_align);
-                       df->var_off = sc->sc_scope->sc_off;
-                       df->var_name = 0;
-                       sc->sc_scope->sc_off += type->tp_size;
-               }
                else {
                        /* Global name, possibly external
                        */
                        sprint(buf,"%s_%s", sc->sc_scope->sc_name,
                                            df->df_idf->id_text);
-                       df->var_name = Malloc((unsigned)(strlen(buf)+1));
-                       strcpy(df->var_name, buf);
+                       df->var_name = Salloc(buf, (unsigned)(strlen(buf)+1));
 
                        if (DefinitionModule) {
                                C_exa_dnam(df->var_name);
index 80a7578..983042c 100644 (file)
@@ -175,7 +175,6 @@ factor(struct node **p;)
 {
        struct def *df;
        struct node *nd;
-       register struct type *tp;
 } :
        qualident(0, &df, (char *) 0, p)
        [
index bc60888..7dd53d9 100644 (file)
@@ -6,3 +6,18 @@
 struct f_info  file_info;
 #include       "input.h"
 #include       <inp_pkg.body>
+
+AtEoIF()
+{
+       /*      Make the unstacking of input streams noticable to the
+               lexical analyzer
+       */
+       return 1;
+}
+
+AtEoIT()
+{
+       /*      Make the end of the text noticable
+       */
+       return 1;
+}
index 1372165..54857dd 100644 (file)
@@ -23,14 +23,15 @@ static char *RcsId = "$Header$";
 #include       "tokenname.h"
 #include       "node.h"
 
-int    state;                  /* either IMPLEMENTATION or PROGRAM */
-char   options[128];
-int    DefinitionModule; 
-int    SYSTEMModule = 0;
-char   *ProgName;
-char   *DEFPATH[NDIRS+1];
-struct def *Defined;
-extern int err_occurred;
+int            state;                  /* either IMPLEMENTATION or PROGRAM */
+char           options[128];
+int            DefinitionModule; 
+int            SYSTEMModule = 0;
+char           *ProgName;
+char           *DEFPATH[NDIRS+1];
+struct def     *Defined;
+extern int     err_occurred;
+extern int     fp_used;                /* set if floating point used */
 
 main(argc, argv)
        char *argv[];
@@ -75,8 +76,8 @@ Compile(src, dst)
        init_idf();
        InitCst();
        reserve(tkidf);
-       init_scope();
-       init_types();
+       InitScope();
+       InitTypes();
        InitDef();
        AddStandards();
 #ifdef DEBUG
@@ -94,12 +95,16 @@ Compile(src, dst)
        C_magic();
        C_ms_emx(word_size, pointer_size);
        CompUnit();
+       C_ms_src((arith) (LineNumber - 1), FileName);
        close_scope(SC_REVERSE);
        if (err_occurred) {
                C_close();
                return 0;
        }
        WalkModule(Defined);
+       if (fp_used) {
+               C_ms_flt();
+       }
        C_close();
 #ifdef DEBUG
        if (options['m']) MemUse();
@@ -210,17 +215,9 @@ END SYSTEM.\n";
        }
        SYSTEMModule = 1;
        DefModule();
-       close_scope(0);
        SYSTEMModule = 0;
 }
 
-AtEoIT()
-{
-       /*      Make the end of the text noticable
-       */
-       return 1;
-}
-
 #ifdef DEBUG
 MemUse()
 {
index cbf86b8..cf8aed1 100644 (file)
@@ -49,7 +49,7 @@ ModuleDeclaration
        struct node *nd;
        struct node *exportlist = 0;
        int qualified;
-       extern char *sprint(), *Malloc(), *strcpy();
+       extern char *sprint();
 } :
        MODULE IDENT    {
                          id = dot.TOK_IDF;
@@ -67,10 +67,9 @@ ModuleDeclaration
 
                          df->df_type = standard_type(T_RECORD, 0, (arith) 0);
                          df->df_type->rec_scope = df->mod_vis->sc_scope;
-                         sprint(buf, "__%d%s", ++modulecount, id->id_text);
+                         sprint(buf, "_%d%s", ++modulecount, id->id_text);
                          CurrentScope->sc_name =
-                               Malloc((unsigned) (strlen(buf) + 1));
-                         strcpy(CurrentScope->sc_name, buf);
+                               Salloc(buf, (unsigned) (strlen(buf) + 1));
                          if (! proclevel) C_ina_dnam(&buf[1]);
                          C_inp(buf);
                        }
@@ -177,7 +176,7 @@ DefinitionModule
                                df->df_flags |= D_QEXPORTED;
                                df = df->df_nextinscope;
                          }
-                         if (!SYSTEMModule) close_scope(SC_CHKFORW);
+                         close_scope(SC_CHKFORW);
                          DefinitionModule--;
                          match_id(id, dot.TOK_IDF);
                        }
index c359cfc..f1731fb 100644 (file)
@@ -36,7 +36,7 @@ open_scope(scopetype)
        
        assert(scopetype == OPENSCOPE || scopetype == CLOSEDSCOPE);
 
-       clear((char *) sc, sizeof (*sc));
+       clear((char *) sc, sizeof (struct scope));
        sc->sc_scopeclosed = scopetype == CLOSEDSCOPE;
        sc->sc_level = proclevel;
        if (scopetype == OPENSCOPE) {
@@ -48,7 +48,7 @@ open_scope(scopetype)
        CurrVis = ls;
 }
 
-init_scope()
+InitScope()
 {
        register struct scope *sc = new_scope();
        register struct scopelist *ls = new_scopelist();
index c7841b0..983b13e 100644 (file)
@@ -22,7 +22,7 @@
 
 /* Standard procedures and functions defined in the SYSTEM module ... */
 
-#define S_ADR  20
-#define S_TSIZE        21
-#define S_NEWPROCESS   22
-#define S_TRANSFER     23
+#define S_ADR  50
+#define S_TSIZE        51
+#define S_NEWPROCESS   52
+#define S_TRANSFER     53
index 974c866..89360b8 100644 (file)
@@ -153,7 +153,7 @@ standard_type(fund, align, size)
        return tp;
 }
 
-init_types()
+InitTypes()
 {
        /*      Initialize the predefined types
        */
@@ -434,7 +434,7 @@ ArrayElSize(tp)
        if (tp->tp_fund == T_ARRAY) ArraySizes(tp);
        algn = align(tp->tp_size, tp->tp_align);
        if (!(algn % word_size == 0 || word_size % algn == 0)) {
-               algn = align(algn, word_size);
+               algn = align(algn, (int) word_size);
        }
        return algn;
 }
index eb655e6..cc48c91 100644 (file)
@@ -78,26 +78,10 @@ WalkModule(module)
        CurrVis = module->mod_vis;
        sc = CurrentScope;
 
-       if (!proclevel && module != Defined) {
-               /* This module is a local module, but not within a
-                  procedure. Generate code to allocate storage for its
-                  variables. This is done by generating a "bss",
-                  with label "_<modulenumber><modulename>".
-               */
-               arith size = align(sc->sc_off, word_align);
-
-               if (size == 0) size = word_size;
-               /* WHY ??? because we generated an INA for it ??? */
-
-               C_df_dnam(&(sc->sc_name[1]));
-               size = align(size, word_align);
-               C_bss_cst(size, (arith) 0, 0);
-               C_exp(sc->sc_name);
-       }
-       else if (CurrVis == Defined->mod_vis) {
-               /* This module is the module currently being compiled.
-                  Again, generate code to allocate storage for its
-                  variables, which all have an explicit name.
+       if (!proclevel) {
+               /* This module is a glocal module.
+                  Generate code to allocate storage for its variables.
+                  They all have an explicit name.
                */
                while (df) {
                        if (df->df_kind == D_VARIABLE) {
@@ -369,11 +353,9 @@ WalkStat(nd, lab)
                        struct node *fnd;
                        label l1 = instructionlabel++;
                        label l2 = instructionlabel++;
-                       arith size;
 
                        if (! DoForInit(nd, left)) break;
                        fnd = left->nd_right;
-                       size = fnd->nd_type->tp_size;
                        if (fnd->nd_class != Value) {
                                CodePExpr(fnd);
                                tmp = NewInt();
@@ -513,7 +495,7 @@ DoForInit(nd, left)
 
        if (! chk_designator(nd, VARIABLE, D_DEFINED) ||
            ! chk_expr(left->nd_left) ||
-           ! chk_expr(left->nd_right)) return;
+           ! chk_expr(left->nd_right)) return 0;
 
        if (nd->nd_type->tp_size > word_size ||
            !(nd->nd_type->tp_fund & T_DISCRETE)) {
@@ -533,6 +515,8 @@ node_warning(nd, "old-fashioned! compatibility required in FOR statement");
 
        CodePExpr(left->nd_left);
        CodeDStore(nd);
+
+       return 1;
 }
 
 DoAssign(nd, left, right)