newer version
authorceriel <none@none>
Tue, 15 Apr 1986 17:51:53 +0000 (17:51 +0000)
committerceriel <none@none>
Tue, 15 Apr 1986 17:51:53 +0000 (17:51 +0000)
17 files changed:
lang/m2/comp/LLlex.c
lang/m2/comp/LLlex.h
lang/m2/comp/chk_expr.c
lang/m2/comp/declar.g
lang/m2/comp/def.H
lang/m2/comp/def.c
lang/m2/comp/defmodule.c
lang/m2/comp/enter.c
lang/m2/comp/expression.g
lang/m2/comp/main.c
lang/m2/comp/program.g
lang/m2/comp/scope.C
lang/m2/comp/scope.h
lang/m2/comp/statement.g
lang/m2/comp/type.H
lang/m2/comp/type.c
lang/m2/comp/typequiv.c

index b0eb90e..db080a5 100644 (file)
@@ -4,13 +4,16 @@ static char *RcsId = "$Header$";
 
 #include       <alloc.h>
 #include       <em_arith.h>
+#include       <em_label.h>
 #include       <assert.h>
 #include       "input.h"
 #include       "f_info.h"
 #include       "Lpars.h"
 #include       "class.h"
 #include       "idf.h"
+#include       "type.h"
 #include       "LLlex.h"
+#include       "const.h"
 
 #define IDFSIZE        256     /* Number of significant characters in an identifier */
 #define NUMSIZE        256     /* maximum number of characters in a number */
@@ -18,6 +21,7 @@ static char *RcsId = "$Header$";
 long str2long();
 
 struct token dot, aside;
+struct type *numtype;
 struct string string;
 
 static
@@ -102,6 +106,7 @@ LLlex()
        char buf[(IDFSIZE > NUMSIZE ? IDFSIZE : NUMSIZE) + 1];
        register int ch, nch;
 
+       numtype = error_type;
        if (ASIDE)      {       /* a token is put aside         */
                *tk = aside;
                ASIDE = 0;
@@ -236,7 +241,7 @@ again:
                switch (ch) {
                case 'H':
 Shex:                  *np++ = '\0';
-                       /* Type is integer */
+                       numtype = card_type;
                        tk->TOK_INT = str2long(&buf[1], 16);
                        return tk->tk_symb = INTEGER;
 
@@ -271,10 +276,10 @@ Shex:                     *np++ = '\0';
                        PushBack(ch);
                        ch = *--np;
                        *np++ = '\0';
-                       /*
-                        * If (ch == 'C') type is a CHAR
-                        * else type is an INTEGER
-                        */
+                       if (ch == 'C') {
+                               numtype = char_type;
+                       }
+                       else    numtype = card_type;
                        tk->TOK_INT = str2long(&buf[1], 8);
                        return tk->tk_symb = INTEGER;
 
@@ -369,8 +374,11 @@ Sreal:
                        PushBack(ch);
 Sdec:
                        *np++ = '\0';
-                       /* Type is an integer */
                        tk->TOK_INT = str2long(&buf[1], 10);
+                       if (tk->TOK_INT < 0 || tk->TOK_INT > max_int) {
+                               numtype = card_type;
+                       }
+                       else    numtype = intorcard_type;
                        return tk->tk_symb = INTEGER;
                }
                /*NOTREACHED*/
index db49e6b..31ddcd4 100644 (file)
@@ -28,6 +28,7 @@ struct token  {
 #define TOK_REL        tk_data.tk_real
 
 extern struct token dot, aside;
+extern struct type *numtype;
 
 #define DOT    dot.tk_symb
 #define ASIDE  aside.tk_symb
index 67075d1..fdd55cb 100644 (file)
@@ -266,7 +266,9 @@ node_error(expp, "Size of type in type cast does not match size of operand");
                }
                arg->nd_type = left->nd_type;
                FreeNode(expp->nd_left);
-               *expp = *(arg->nd_left);
+               expp->nd_right->nd_left = 0;
+               FreeNode(expp->nd_right);
+               *expp = *arg;
                arg->nd_left = 0;
                arg->nd_right = 0;
                FreeNode(arg);
@@ -451,8 +453,6 @@ findname(expp)
        register struct def *df;
        struct def *lookfor();
        register struct type *tp;
-       int scope;
-       int module;
 
        expp->nd_type = error_type;
        if (expp->nd_class == Name) {
@@ -596,7 +596,7 @@ node_error(expp, "IN operator: type of LHS not compatible with element type of R
 
        if (!TstCompat(tpl, tpr)) {
                node_error(expp,
-                          "Incompatible types for operator \"%s\"",
+                          "incompatible types for operator \"%s\"",
                           symbol2str(expp->nd_symb));
                return 0;
        }
index 0624458..afedfbb 100644 (file)
@@ -14,6 +14,8 @@ static char *RcsId = "$Header$";
 #include       "scope.h"
 #include       "node.h"
 #include       "misc.h"
+
+static int     proclevel = 0;  /* nesting level of procedures */
 }
 
 ProcedureDeclaration
@@ -21,10 +23,13 @@ ProcedureDeclaration
        struct def *df;
 } :
        ProcedureHeading(&df, D_PROCEDURE)
+                       { df->prc_level = proclevel++;
+                       }
        ';' block IDENT
                        { match_id(dot.TOK_IDF, df->df_idf);
-                         df->prc_scope = CurrentScope->sc_scope;
+                         df->prc_scope = CurrentScope;
                          close_scope(SC_CHKFORW);
+                         proclevel--;
                        }
 ;
 
@@ -36,38 +41,38 @@ ProcedureHeading(struct def **pdf; int type;)
        register struct def *df;
 } :
        PROCEDURE IDENT
-                       { assert(type & (D_PROCEDURE | D_PROCHEAD));
-                         if (type == D_PROCHEAD) {
-                               df = define(dot.TOK_IDF, CurrentScope, type);
-                               df->for_node = MkNode(Name, NULLNODE, NULLNODE, &dot);
-                         }
-                         else {
-                               df = lookup(dot.TOK_IDF,
-                                               CurrentScope->sc_scope);
-                               if (df && df->df_kind == D_PROCHEAD) {
-                                       df->df_kind = type;
-                                       tp1 = df->df_type;
-                               }
-                               else {
-                                       df = define(dot.TOK_IDF,
-                                               CurrentScope, type);
-                               }
-                               open_scope(OPENSCOPE, 0);
-                         }
+               { assert(type & (D_PROCEDURE | D_PROCHEAD));
+                 if (type == D_PROCHEAD) {
+                       df = define(dot.TOK_IDF, CurrentScope, type);
+                       df->for_node = MkNode(Name, NULLNODE, NULLNODE, &dot);
+                 }
+                 else {
+                       df = lookup(dot.TOK_IDF, CurrentScope);
+                       if (df && df->df_kind == D_PROCHEAD) {
+                               df->df_kind = type;
+                               tp1 = df->df_type;
                        }
-       FormalParameters(type == D_PROCEDURE, &params, &tp)?
-                       {
-                         df->df_type = tp = construct_type(T_PROCEDURE, tp);
-                         tp->prc_params = params;
-                         if (tp1 && !TstTypeEquiv(tp, tp1)) {
+                       else    df = define(dot.TOK_IDF, CurrentScope, type);
+                       df->prc_nbpar = 0;
+                       open_scope(OPENSCOPE);
+                 }
+               }
+       FormalParameters(type == D_PROCEDURE, &params, &tp, &(df->prc_nbpar))?
+               {
+                 df->df_type = tp = construct_type(T_PROCEDURE, tp);
+                 tp->prc_params = params;
+                 if (tp1 && !TstTypeEquiv(tp, tp1)) {
 error("inconsistent procedure declaration for \"%s\"", df->df_idf->id_text); 
-                         }
-                         *pdf = df;
-                       }
+                 }
+                 *pdf = df;
+               }
 ;
 
-block:
-       declaration* [ BEGIN StatementSequence ]? END
+block
+{
+       struct node *nd;
+}:
+       declaration* [ BEGIN StatementSequence(&nd) ]? END
 ;
 
 declaration:
@@ -82,18 +87,21 @@ declaration:
        ModuleDeclaration ';'
 ;
 
-FormalParameters(int doparams; struct paramlist **pr; struct type **tp;)
+FormalParameters(int doparams;
+                struct paramlist **pr;
+                struct type **tp;
+                arith *parmaddr;)
 {
        struct def *df;
        register struct paramlist *pr1;
 } :
        '('
        [
-               FPSection(doparams, pr) 
+               FPSection(doparams, pr, parmaddr)       
                        { pr1 = *pr; }
                [
                        { for (; pr1->next; pr1 = pr1->next) ; }
-                       ';' FPSection(doparams, &(pr1->next))
+                       ';' FPSection(doparams, &(pr1->next), &parmaddr)
                ]*
        ]?
        ')'
@@ -109,7 +117,7 @@ FormalParameters(int doparams; struct paramlist **pr; struct type **tp;)
        because in this case we only read the header. The Implementation
        might contain different identifiers representing the same paramters.
 */
-FPSection(int doparams; struct paramlist **ppr;)
+FPSection(int doparams; struct paramlist **ppr; arith *addr;)
 {
        struct node *FPList;
        struct paramlist *ParamList();
@@ -122,7 +130,8 @@ FPSection(int doparams; struct paramlist **ppr;)
        IdentList(&FPList) ':' FormalType(&tp)
                {
                  if (doparams) {
-                       EnterIdList(FPList, D_VARIABLE, VARp, tp, CurrentScope);
+                       EnterIdList(FPList, D_VARIABLE, VARp,
+                                   tp, CurrentScope, addr);
                  }
                  *ppr = ParamList(FPList, tp, VARp);
                  FreeNode(FPList);
@@ -140,6 +149,9 @@ FormalType(struct type **tp;)
                        { if (ARRAYflag) {
                                *tp = construct_type(T_ARRAY, NULLTYPE);
                                (*tp)->arr_elem = df->df_type;
+                               (*tp)->tp_align = lcm(wrd_align, ptr_align);
+                               (*tp)->tp_size = align(ptr_size + 3*wrd_size,
+                                                       (*tp)->tp_align);
                          }
                          else  *tp = df->df_type;
                        }
@@ -209,11 +221,20 @@ enumeration(struct type **ptp;)
 } :
        '(' IdentList(&EnumList) ')'
                {
-                 *ptp = standard_type(T_ENUMERATION,int_align,int_size);
-                 EnterIdList(EnumList, D_ENUM, 0, *ptp, CurrentScope);
+                 *ptp = standard_type(T_ENUMERATION,1,1);
+                 EnterIdList(EnumList, D_ENUM, 0, *ptp,
+                               CurrentScope, (arith *) 0);
                  FreeNode(EnumList);
+                 if ((*ptp)->enm_ncst > 256) {
+                       if (wrd_size == 1) {
+                               error("Too many enumeration literals");
+                       }
+                       else {
+                               (*ptp)->tp_size = wrd_size;
+                               (*ptp)->tp_align = wrd_align;
+                       }
+                 }
                }
-
 ;
 
 IdentList(struct node **p;)
@@ -261,44 +282,52 @@ ArrayType(struct type **ptp;)
                                construct_type(T_ARRAY, tp);
                        }
        ]* OF type(&tp)
-                       { tp2->arr_elem = tp; }
+                       { tp2->arr_elem = tp;
+                         ArraySizes(*ptp);
+                       }
 ;
 
 RecordType(struct type **ptp;)
 {
-       struct scope scope;
+       struct scope *scope;
+       arith count;
+       int xalign = record_align;
 }
 :
        RECORD
-                       { scope.sc_scope = uniq_scope();
-                         scope.next = CurrentScope;
+                       { open_scope(OPENSCOPE);
+                         scope = CurrentScope;
+                         close_scope(0);
+                         count = 0;
                        }
-       FieldListSequence(&scope)
+       FieldListSequence(scope, &count, &xalign)
                {
-                 *ptp = standard_type(T_RECORD, record_align, (arith) 0 /* ???? */);
-                 (*ptp)->rec_scope = scope.sc_scope;
+                 *ptp = standard_type(T_RECORD, xalign, count);
+                 (*ptp)->rec_scope = scope;
                }
        END
 ;
 
-FieldListSequence(struct scope *scope;):
-       FieldList(scope)
+FieldListSequence(struct scope *scope; arith *cnt; int *palign;):
+       FieldList(scope, cnt, palign)
        [
-               ';' FieldList(scope)
+               ';' FieldList(scope, cnt, palign)
        ]*
 ;
 
-FieldList(struct scope *scope;)
+FieldList(struct scope *scope; arith *cnt; int *palign;)
 {
        struct node *FldList;
        struct idf *id;
-       struct def *df, *df1;
+       struct def *df;
        struct type *tp;
        struct node *nd;
+       arith tcnt, max;
 } :
 [
        IdentList(&FldList) ':' type(&tp)
-                       { EnterIdList(FldList, D_FIELD, 0, tp, scope);
+                       { *palign = lcm(*palign, tp->tp_align);
+                         EnterIdList(FldList, D_FIELD, 0, tp, scope, cnt);
                          FreeNode(FldList);
                        }
 |
@@ -309,8 +338,7 @@ FieldList(struct scope *scope;)
                [       /* This is good, in both kinds of Modula-2, if
                           the first qualident is a single identifier.
                        */
-                       {
-                         if (nd->nd_class != Name) {
+                       { if (nd->nd_class != Name) {
                                error("illegal variant tag");
                                id = gen_anon_idf();
                          }
@@ -322,8 +350,7 @@ FieldList(struct scope *scope;)
                        /* Old fashioned! the first qualident now represents
                           the type
                        */
-                               {
-                                 warning("Old fashioned Modula-2 syntax!");
+                               { warning("Old fashioned Modula-2 syntax!");
                                  id = gen_anon_idf();
                                  findname(nd);
                                  assert(nd->nd_class == Def);
@@ -338,42 +365,62 @@ FieldList(struct scope *scope;)
                ]
        |
                /* Aha, third edition? */
-               ':' qualident(D_TYPE|D_HTYPE|D_HIDDEN,
-                             &df,
-                             "type",
-                             (struct node **) 0)
-                               {
-                                 id = gen_anon_idf();
-                               }
+               ':' qualident(D_TYPE|D_HTYPE|D_HIDDEN, &df, "type", (struct node **) 0)
+                               { id = gen_anon_idf(); }
        ]
-                               {
-                                 df1 = define(id, scope, D_FIELD);
-                                 df1->df_type = df->df_type;
+                               { tp = df->df_type;
+                                 df = define(id, scope, D_FIELD);
+                                 df->df_type = tp;
+                                 df->fld_off = align(*cnt, tp->tp_align);
+                                 *cnt = tcnt = df->fld_off + tp->tp_size;
                                }
-       OF variant(scope)
+       OF variant(scope, &tcnt, tp, palign)
+                               { max = tcnt; tcnt = *cnt; }
        [
-               '|' variant(scope)
+               '|' variant(scope, &tcnt, tp, palign)
+                               { if (tcnt > max) max = tcnt; }
        ]*
-       [ ELSE FieldListSequence(scope)
+       [ ELSE FieldListSequence(scope, &tcnt, palign)
+                               { if (tcnt > max) max = tcnt; }
        ]?
        END
+                               { *cnt = max; }
 ]?
 ;
 
-variant(struct scope *scope;):
-       [ CaseLabelList ':' FieldListSequence(scope) ]?
+variant(struct scope *scope; arith *cnt; struct type *tp; int *palign;)
+{
+       struct type *tp1 = tp;
+} :
+       [
+               CaseLabelList(&tp1) ':' FieldListSequence(scope, cnt, palign)
+       ]?
                                        /* Changed rule in new modula-2 */
 ;
 
-CaseLabelList:
-       CaseLabels [ ',' CaseLabels ]*
+CaseLabelList(struct type **ptp;):
+       CaseLabels(ptp) [ ',' CaseLabels(ptp) ]*
 ;
 
-CaseLabels
+CaseLabels(struct type **ptp;)
 {
        struct node *nd1, *nd2 = 0;
 }:
-       ConstExpression(&nd1) [ UPTO ConstExpression(&nd2) ]?
+       ConstExpression(&nd1)
+       [
+               UPTO ConstExpression(&nd2)
+                               { if (!TstCompat(nd1->nd_type, nd2->nd_type)) {
+node_error(nd2,"type incompatibility in case label");
+                                 }
+                                 nd1->nd_type = error_type;
+                               }
+       ]?
+                               { if (*ptp != 0 &&
+                                      !TstCompat(*ptp, nd1->nd_type)) {
+node_error(nd1,"type incompatibility in case label");
+                                 }
+                                 *ptp = nd1->nd_type;
+                               }
 ;
 
 SetType(struct type **ptp;)
@@ -398,7 +445,7 @@ PointerType(struct type **ptp;)
        struct node *nd;
 } :
        POINTER TO
-       [ %if ( (df = lookup(dot.TOK_IDF, CurrentScope->sc_scope)))
+       [ %if ( (df = lookup(dot.TOK_IDF, CurrentScope)))
                /* Either a Module or a Type, but in both cases defined
                   in this scope, so this is the correct identification
                */
@@ -489,14 +536,22 @@ VariableDeclaration
 {
        struct node *VarList;
        struct type *tp;
-       struct node *nd = 0;
 } :
-       IdentList(&VarList)
-       [
-               ConstExpression(&nd)
-       ]?
+       IdentAddrList(&VarList)
        ':' type(&tp)
-                       { EnterIdList(VarList, D_VARIABLE, 0, tp, CurrentScope);
+                       { EnterVarList(VarList, tp, proclevel > 0);
                          FreeNode(VarList);
                        }
 ;
+
+IdentAddrList(struct node **pnd;)
+{
+} :
+       IDENT           { *pnd = MkNode(Name, NULLNODE, NULLNODE, &dot); }
+       ConstExpression(&(*pnd)->nd_left)?
+       [               { pnd = &((*pnd)->nd_right); }
+               ',' IDENT
+                       { *pnd = MkNode(Name, NULLNODE, NULLNODE, &dot); }
+               ConstExpression(&(*pnd)->nd_left)?
+       ]*
+;
index 35f7579..6a76293 100644 (file)
@@ -4,14 +4,16 @@
 
 struct module {
        int mo_priority;        /* priority of a module */
-       int mo_scope;           /* scope of this module */
+       struct scope *mo_scope; /* scope of this module */
 #define mod_priority   df_value.df_module.mo_priority
 #define mod_scope      df_value.df_module.mo_scope
 };
 
 struct variable {
        arith va_off;           /* address or offset of variable */
+       char va_addrgiven;      /* an address was given in the program */
 #define var_off                df_value.df_variable.va_off
+#define var_addrgiven  df_value.df_variable.va_addrgiven
 };
 
 struct constant {
@@ -38,8 +40,12 @@ struct field {
 };
 
 struct dfproc {
-       int pr_scope;           /* scope number of procedure */
+       struct scope *pr_scope; /* scope of procedure */
+       int pr_level;           /* depth level of this procedure */
+       arith pr_nbpar;         /* Number of bytes parameters */
 #define prc_scope      df_value.df_proc.pr_scope
+#define prc_level      df_value.df_proc.pr_level
+#define prc_nbpar      df_value.df_proc.pr_nbpar
 };
 
 struct import {
@@ -48,7 +54,7 @@ struct import {
 };
 
 struct dforward {
-       int fo_scope;
+       struct scope *fo_scope;
        struct node *fo_node;
 #define for_node       df_value.df_forward.fo_node
 #define for_scope      df_value.df_forward.fo_scope
@@ -59,7 +65,7 @@ struct def    {               /* list of definitions for a name */
        struct def *df_nextinscope;
                                /* link all definitions in a scope */
        struct idf *df_idf;     /* link back to the name */
-       int df_scope;           /* scope in which this definition resides */
+       struct scope *df_scope; /* scope in which this definition resides */
        short df_kind;          /* the kind of this definition: */
 #define D_MODULE       0x0001  /* a module */
 #define D_PROCEDURE    0x0002  /* procedure of function */
index c47b321..4ebdef0 100644 (file)
@@ -18,7 +18,7 @@ static char *RcsId = "$Header$";
 struct def *h_def;             /* Pointer to free list of def structures */
 
 static struct def illegal_def =
-       {0, 0, 0, -20 /* Illegal scope */, D_ERROR};
+       {0, 0, 0, 0, D_ERROR};
 
 struct def *ill_df = &illegal_def;
 
@@ -32,17 +32,17 @@ define(id, scope, kind)
        */
        register struct def *df;
 
-       DO_DEBUG(5, debug("Defining identifier \"%s\" in scope %d, kind = %d",
-                         id->id_text, scope->sc_scope, kind));
-       df = lookup(id, scope->sc_scope);
+       DO_DEBUG(5, debug("Defining identifier \"%s\", kind = %d",
+                         id->id_text, kind));
+       df = lookup(id, scope);
        if (    /* Already in this scope */
                df
           ||   /* A closed scope, and id defined in the pervasive scope */
                ( CurrentScope == scope 
                &&
-                 scopeclosed(CurrentScope)
+                 scopeclosed(scope)
                &&
-                 (df = lookup(id, 0)))
+                 (df = lookup(id, PervasiveScope)))
           ) {
                switch(df->df_kind) {
                case D_PROCHEAD:
@@ -62,7 +62,6 @@ define(id, scope, kind)
                        break;
                case D_FORWMODULE:
                        if (kind == D_FORWMODULE) {
-                               df->df_kind = kind;
                                return df;
                        }
                        if (kind == D_MODULE) {
@@ -89,8 +88,9 @@ error("identifier \"%s\" already declared", id->id_text);
        df = new_def();
        df->df_flags = 0;
        df->df_idf = id;
-       df->df_scope = scope->sc_scope;
+       df->df_scope = scope;
        df->df_kind = kind;
+       df->df_type = 0;
        df->next = id->id_def;
        id->id_def = df;
 
@@ -103,6 +103,7 @@ error("identifier \"%s\" already declared", id->id_text);
 struct def *
 lookup(id, scope)
        register struct idf *id;
+       struct scope *scope;
 {
        /*      Look up a definition of an identifier in scope "scope".
                Make the "def" list self-organizing.
@@ -114,7 +115,6 @@ lookup(id, scope)
 
        df1 = 0;
        df = id->id_def;
-       DO_DEBUG(5, debug("Looking for identifier \"%s\" in scope %d", id->id_text, scope));
        while (df) {
                if (df->df_scope == scope) {
                        retval = df;
@@ -148,7 +148,7 @@ Export(ids, qualified)
        struct node *nd = ids;
 
        while (ids) {
-               df = lookup(ids->nd_IDF, CurrentScope->sc_scope);
+               df = lookup(ids->nd_IDF, CurrentScope);
                if (df && (df->df_flags & (D_EXPORTED|D_QEXPORTED))) {
 node_error(ids, "Identifier \"%s\" occurs more than once in export list",
 df->df_idf->id_text);
@@ -163,8 +163,7 @@ df->df_idf->id_text);
                }
                else {
                        df->df_flags |= D_EXPORTED;
-                       df1 = lookup(ids->nd_IDF,
-                                    enclosing(CurrentScope)->sc_scope);
+                       df1 = lookup(ids->nd_IDF, enclosing(CurrentScope));
                        if (! df1 || !(df1->df_kind & (D_PROCHEAD|D_HIDDEN))) {
                                df1 = define(ids->nd_IDF,
                                                enclosing(CurrentScope),
@@ -185,6 +184,49 @@ df->df_idf->id_text);
        FreeNode(nd);
 }
 
+static struct scope *
+ForwModule(df, idn)
+       register struct def *df;
+       struct node *idn;
+{
+       /*      An import is done from a not yet defined module "idn".
+               Create a declaration and a scope for this module.
+       */
+       struct scope *scope;
+
+       df->df_scope = enclosing(CurrentScope);
+       df->df_kind = D_FORWMODULE;
+       open_scope(CLOSEDSCOPE);
+       scope = CurrentScope;   /* The new scope, but watch out, it's "next"
+                                  field is not set right. It must indicate the
+                                  enclosing scope, but this must be done AFTER
+                                  closing this one
+                               */
+       df->for_scope = scope;
+       df->for_node = MkNode(Name, NULLNODE, NULLNODE, &(idn->nd_token));
+       close_scope(0); 
+       scope->next = df->df_scope;
+                               /* Here ! */
+       return scope;
+}
+
+static struct def *
+ForwDef(ids, scope)
+       register struct node *ids;
+       struct scope *scope;
+{
+       /*      Enter a forward definition of "ids" in scope "scope",
+               if it is not already defined.
+       */
+       register struct def *df;
+
+       if (!(df = lookup(ids->nd_IDF, scope))) {
+               df = define(ids->nd_IDF, scope, D_FORWARD);
+               df->for_node = MkNode(Name,NULLNODE,NULLNODE,&(ids->nd_token));
+       }
+       return df;
+}
+
 Import(ids, idn, local)
        register struct node *ids;
        struct node *idn;
@@ -203,63 +245,51 @@ Import(ids, idn, local)
                identifiers defined in this module.
        */
        register struct def *df;
-       struct def *df1 = 0;
-       int scope;
-       int kind;
-       int imp_kind;
+       struct scope *scope = enclosing(CurrentScope);
+       int kind = D_IMPORT;
+       int forwflag = 0;
 #define FROM_MODULE    0
 #define FROM_ENCLOSING 1
+       int imp_kind = FROM_ENCLOSING;
        struct def *lookfor(), *GetDefinitionModule();
 
-       kind = D_IMPORT;
-       scope = enclosing(CurrentScope)->sc_scope;
-
-       if (! idn) imp_kind = FROM_ENCLOSING;
-       else {
+       if (idn) {
                imp_kind = FROM_MODULE;
                if (local) {
-                       df = lookfor(idn, enclosing(CurrentScope), 0);
-                       if (df->df_kind == D_ERROR) {
+                       df = lookfor(idn, scope, 0);
+                       switch(df->df_kind) {
+                       case D_ERROR:
                                /* The module from which the import was done
                                   is not yet declared. I'm not sure if I must
                                   accept this, but for the time being I will.
                                   ???
                                */
-                               df->df_scope = scope;
-                               df->df_kind = D_FORWMODULE;
-                               open_scope(CLOSEDSCOPE, 0);
-                               df->for_scope = CurrentScope->sc_scope;
-                               df->for_node = MkNode(Name, NULLNODE,
-                                               NULLNODE, &(idn->nd_token));
-                               close_scope();
-                               df1 = df;
-                       }
-               }
-               else    df = GetDefinitionModule(idn->nd_IDF);
-
-               if (!(df->df_kind & (D_MODULE|D_FORWMODULE))) {
-                       /* enter all "ids" with type D_ERROR */
-                       kind = D_ERROR;
-                       if (df->df_kind != D_ERROR) {
+                               scope = ForwModule(df, idn);
+                               forwflag = 1;
+                               break;
+                       case D_FORWMODULE:
+                               scope = df->for_scope;
+                               break;
+                       case D_MODULE:
+                               scope = df->mod_scope;
+                               break;
+                       default:
+                               kind = D_ERROR;
 node_error(idn, "identifier \"%s\" does not represent a module",
 idn->nd_IDF->id_text);
+                               break;
                        }
                }
-               else    scope = df->mod_scope;
+               else    scope = GetDefinitionModule(idn->nd_IDF)->mod_scope;
+
                FreeNode(idn);
        }
 
        idn = ids;
        while (ids) {
                if (imp_kind == FROM_MODULE) {
-                       if (df1 != 0) {
-                               open_scope(CLOSEDSCOPE, df1->mod_scope);
-                               df = define(ids->nd_IDF,
-                                           CurrentScope,
-                                           D_FORWARD);
-                               df->for_node = MkNode(Name, NULLNODE,
-                                               NULLNODE, &(ids->nd_token));
-                               close_scope(0);
+                       if (forwflag) {
+                               df = ForwDef(ids, scope);
                        }
                        else if (!(df = lookup(ids->nd_IDF, scope))) {
 node_error(ids, "identifier \"%s\" not declared in qualifying module",
@@ -272,29 +302,22 @@ ids->nd_IDF->id_text);
                        }
                }
                else {
-                       if (local) {
-                               df = lookfor(ids, enclosing(CurrentScope), 0);
-                       } else  df = GetDefinitionModule(ids->nd_IDF);
-                       if (df->df_kind == D_ERROR) {
-                               /* It was not yet defined in the enclosing
-                                  scope.
-                               */
-                               df->df_kind = D_FORWARD;
-                               df->for_node = MkNode(Name, NULLNODE, NULLNODE,
-                                                       &(ids->nd_token));
-                       }
+                       if (local) df = ForwDef(ids, scope);
+                       else    df = GetDefinitionModule(ids->nd_IDF);
                }
+
 DO_DEBUG(2, debug("importing \"%s\", kind %d", ids->nd_IDF->id_text,
 df->df_kind));
                define(ids->nd_IDF, CurrentScope, kind)->imp_def = df;
                if (df->df_kind == D_TYPE &&
                    df->df_type->tp_fund == T_ENUMERATION) {
-                       /* Also import all enumeration literals */
-                       exprt_literals(df->df_type->enm_enums,
-                                       CurrentScope);
+                       /* Also import all enumeration literals
+                       */
+                       exprt_literals(df->df_type->enm_enums, CurrentScope);
                }
                ids = ids->next;
        }
+
        FreeNode(idn);
 }
 
@@ -305,9 +328,9 @@ exprt_literals(df, toscope)
        /*      A list of enumeration literals is exported. This is implemented
                as an import from the scope "toscope".
        */
-       DO_DEBUG(2, debug("enumeration import:"));
+       DO_DEBUG(3, debug("enumeration import:"));
        while (df) {
-               DO_DEBUG(2, debug(df->df_idf->id_text));
+               DO_DEBUG(3, debug(df->df_idf->id_text));
                define(df->df_idf, toscope, D_IMPORT)->imp_def = df;
                df = df->enm_next;
        }
@@ -353,3 +376,11 @@ RemFromId(df)
                df1->next = df->next;
        }
 }
+
+#ifdef DEBUG
+PrDef(df)
+       register struct def *df;
+{
+       debug("name: %s, kind: %d", df->df_idf->id_text, df->df_kind);
+}
+#endif DEBUG
index 8dd739a..7a26111 100644 (file)
@@ -49,7 +49,7 @@ GetDefinitionModule(id)
        */
        struct def *df;
 
-       df = lookup(id, GlobalScope->sc_scope);
+       df = lookup(id, GlobalScope);
        if (!df) {
                /* Read definition module. Make an exception for SYSTEM.
                */
@@ -60,7 +60,7 @@ GetDefinitionModule(id)
                        GetFile(id->id_text);
                        DefModule();
                }
-               df = lookup(id, GlobalScope->sc_scope);
+               df = lookup(id, GlobalScope);
        }
        assert(df != 0 && df->df_kind == D_MODULE);
        return df;
index 52380bc..4c9e14b 100644 (file)
@@ -35,10 +35,11 @@ Enter(name, kind, type, pnam)
        return df;
 }
 
-EnterIdList(idlist, kind, flags, type, scope)
+EnterIdList(idlist, kind, flags, type, scope, addr)
        register struct node *idlist;
        struct type *type;
        struct scope *scope;
+       arith *addr;
 {
        /*      Put a list of identifiers in the symbol table.
                They all have kind "kind", and type "type", and are put
@@ -50,11 +51,29 @@ EnterIdList(idlist, kind, flags, type, scope)
        register struct def *df;
        struct def *first = 0, *last = 0;
        int assval = 0;
+       arith off;
 
        while (idlist) {
                df = define(idlist->nd_IDF, scope, kind);
                df->df_type = type;
                df->df_flags |= flags;
+               if (addr) {
+                       if (*addr >= 0) {
+                               off = align(*addr, type->tp_align);
+                               *addr = off + type->tp_size;
+                       }
+                       else {
+                               off = -align(-*addr, type->tp_align);
+                               *addr = off - type->tp_size;
+                       }
+                       if (kind == D_VARIABLE) {
+                               df->var_off = off;
+                       }
+                       else {
+                               assert(kind == D_FIELD);
+                               df->fld_off = off;
+                       }
+               }
                if (kind == D_ENUM) {
                        if (!first) first = df;
                        df->enm_val = assval++;
@@ -72,6 +91,45 @@ EnterIdList(idlist, kind, flags, type, scope)
        }
 }
 
+EnterVarList(IdList, type, local)
+       register struct node *IdList;
+       struct type *type;
+{
+       register struct def *df;
+       struct scope *scope;
+
+       if (local) {
+               /* Find the closest enclosing open scope. This
+                  is the procedure that we are dealing with
+               */
+               scope = CurrentScope;
+               while (scope->sc_scopeclosed) scope = scope->next;
+       }
+
+       while (IdList) {
+               df = define(IdList->nd_IDF, CurrentScope, D_VARIABLE);
+               df->df_type = type;
+               if (IdList->nd_left) {
+                       df->var_addrgiven = 1;
+                       if (IdList->nd_left->nd_type != card_type) {
+node_error(IdList->nd_left,"Illegal type for address");
+                       }
+                       df->var_off = IdList->nd_left->nd_INT;
+               }
+               else if (local) {
+                       arith off;
+
+                       /* add aligned size of variable to the offset
+                       */
+                       off = scope->sc_off - type->tp_size;
+                       off = -align(-off, type->tp_align);
+                       df->var_off = off;
+                       scope->sc_off = off;
+               }
+               IdList = IdList->nd_right;
+       }
+}
+
 struct def *
 lookfor(id, scope, give_error)
        struct node *id;
@@ -86,7 +144,7 @@ lookfor(id, scope, give_error)
        register struct scope *sc = scope;
 
        while (sc) {
-               df = lookup(id->nd_IDF, sc->sc_scope);
+               df = lookup(id->nd_IDF, sc);
                if (df) return df;
                sc = nextvisible(sc);
        }
index dfe210b..75655c9 100644 (file)
@@ -22,9 +22,7 @@ number(struct node **p;)
        struct type *tp;
 } :
 [
-       INTEGER         { tp = dot.TOK_INT <= max_int ?
-                               intorcard_type : card_type;
-                       }
+       INTEGER         { tp = numtype; }
 |
        REAL            { tp = real_type; }
 ]                      { *p = MkNode(Value, NULLNODE, NULLNODE, &dot);
index 08632c0..a66d0aa 100644 (file)
@@ -74,7 +74,7 @@ Compile(src)
        if (options['L']) LexScan();
        else {
 #endif DEBUG
-               (void) open_scope(CLOSEDSCOPE, 0);
+               (void) open_scope(CLOSEDSCOPE);
                GlobalScope = CurrentScope;
                CompUnit();
 #ifdef DEBUG
@@ -192,7 +192,7 @@ PROCEDURE NEWPROCESS(P:PROC; A:ADDRESS; n:CARDINAL; VAR p1:ADDRESS);\n\
 PROCEDURE TRANSFER(VAR p1,p2:ADDRESS);\n\
 END SYSTEM.\n";
 
-       open_scope(CLOSEDSCOPE, 0);
+       open_scope(CLOSEDSCOPE);
        (void) Enter("WORD", D_TYPE, word_type, 0);
        (void) Enter("ADDRESS", D_TYPE, address_type, 0);
        (void) Enter("ADR", D_PROCEDURE, std_type, S_ADR);
@@ -202,7 +202,7 @@ END SYSTEM.\n";
        }
        SYSTEMModule = 1;
        DefModule();
-       close_scope();
+       close_scope(0);
        SYSTEMModule = 0;
 }
 
index 3ff352b..e3c6bb7 100644 (file)
@@ -20,7 +20,6 @@ static int DEFofIMPL = 0;     /* Flag indicating that we are currently
                                   implementation module currently being
                                   compiled
                                */
-static struct def *impl_df;
 }
 /*
        The grammar as given by Wirth is already almost LL(1); the
@@ -50,10 +49,10 @@ ModuleDeclaration
                                  id = dot.TOK_IDF;
                                  df = define(id, CurrentScope, D_MODULE);
                                  if (!df->mod_scope) { 
-                                       open_scope(CLOSEDSCOPE, 0);
-                                       df->mod_scope = CurrentScope->sc_scope;
+                                       open_scope(CLOSEDSCOPE);
+                                       df->mod_scope = CurrentScope;
                                  }
-                                 else  open_scope(CLOSEDSCOPE, df->mod_scope);
+                                 else  CurrentScope = df->mod_scope;
                                  df->df_type = 
                                        standard_type(T_RECORD, 0, (arith) 0);
                                  df->df_type->rec_scope = df->mod_scope;
@@ -123,8 +122,8 @@ DefinitionModule
        DEFINITION
        MODULE IDENT    { id = dot.TOK_IDF;
                          df = define(id, GlobalScope, D_MODULE);
-                         if (!SYSTEMModule) open_scope(CLOSEDSCOPE, 0);
-                         df->mod_scope = CurrentScope->sc_scope;
+                         if (!SYSTEMModule) open_scope(CLOSEDSCOPE);
+                         df->mod_scope = CurrentScope;
                          df->df_type = standard_type(T_RECORD, 0, (arith) 0);
                          df->df_type->rec_scope = df->mod_scope;
                          DefinitionModule = 1;
@@ -144,7 +143,6 @@ DefinitionModule
                                   implementation module being compiled
                                */
                                RemImports(&(CurrentScope->sc_def));
-                               impl_df = CurrentScope->sc_def;
                          }
                          df = CurrentScope->sc_def;
                          while (df) {
@@ -174,7 +172,8 @@ definition
               The export is said to be opaque.
               It is restricted to pointer types.
            */
-                       { df->df_kind = D_HIDDEN; }
+                       { df->df_kind = D_HIDDEN;
+                       }
          ]
          ';'
        ]*
@@ -188,20 +187,19 @@ ProgramModule(int state;)
 {
        struct idf *id;
        struct def *df, *GetDefinitionModule();
-       int scope = 0;
+       struct scope *scope = 0;
 } :
        MODULE
        IDENT           { 
                          id = dot.TOK_IDF;
                          if (state == IMPLEMENTATION) {
-                                  DEFofIMPL = 1;
-                                  df = GetDefinitionModule(id);
-                                  scope = df->mod_scope;
-                                  DEFofIMPL = 0;
+                               DEFofIMPL = 1;
+                               df = GetDefinitionModule(id);
+                               CurrentScope = df->mod_scope;
+                               DEFofIMPL = 0;
+                               DefinitionModule = 0;
                          }
-                         DefinitionModule = 0;
-                         open_scope(CLOSEDSCOPE, scope);
-                         CurrentScope->sc_def = impl_df;
+                         else  open_scope(CLOSEDSCOPE);
                        }
        priority?
        ';' import(0)*
index e7a0fcf..ca60868 100644 (file)
@@ -14,40 +14,28 @@ static char *RcsId = "$Header$";
 #include       "node.h"
 #include       "debug.h"
 
-static int maxscope;           /* maximum assigned scope number */
-
-struct scope *CurrentScope, *GlobalScope;
+struct scope *CurrentScope, *PervasiveScope, *GlobalScope;
 
 /* STATICALLOCDEF "scope" */
 
-open_scope(scopetype, scope)
+open_scope(scopetype)
 {
        /*      Open a scope that is either open (automatic imports) or closed.
-               A closed scope is handled by adding an extra entry to the list
-               with scope number 0. This has two purposes: it makes scope 0
-               visible, and it marks the end of a visibility list.
-               Scope 0 is the pervasive scope, the one that is always visible.
-               A disadvantage of this method is that we cannot open scope 0
-               explicitly.
        */
        register struct scope *sc = new_scope();
        register struct scope *sc1;
 
-       sc->sc_scope = scope == 0 ? ++maxscope : scope;
+       assert(scopetype == OPENSCOPE || scopetype == CLOSEDSCOPE);
+       sc->sc_scopeclosed = scopetype == CLOSEDSCOPE;
        sc->sc_forw = 0;
        sc->sc_def = 0;
-       assert(scopetype == OPENSCOPE || scopetype == CLOSEDSCOPE);
+       sc->sc_off = 0;
+       sc->next = 0;
        DO_DEBUG(1, debug("Opening a %s scope",
                        scopetype == OPENSCOPE ? "open" : "closed"));
-       sc1 = CurrentScope;
-       if (scopetype == CLOSEDSCOPE) {
-               sc1 = new_scope();
-               sc1->sc_scope = 0;              /* Pervasive scope nr */
-               sc1->sc_forw = 0;
-               sc1->sc_def = 0;
-               sc1->next = CurrentScope;
+       if (CurrentScope != PervasiveScope) {
+               sc->next = CurrentScope;
        }
-       sc->next = sc1;
        CurrentScope = sc;
 }
 
@@ -55,18 +43,14 @@ init_scope()
 {
        register struct scope *sc = new_scope();
 
-       sc->sc_scope = 0;
+       sc->sc_scopeclosed = 0;
        sc->sc_forw = 0;
        sc->sc_def = 0;
+       sc->next = 0;
+       PervasiveScope = sc;
        CurrentScope = sc;
 }
 
-int
-uniq_scope()
-{
-       return ++maxscope;
-}
-
 struct forwards {
        struct forwards *next;
        struct node fo_tok;
@@ -92,73 +76,67 @@ Forward(tk, ptp)
        CurrentScope->sc_forw = f;
 }
 
-close_scope(flag)
+static
+chk_proc(df)
+       register struct def *df;
 {
-       /*      Close a scope. If "flag" is set, check for forward declarations,
-               either POINTER declarations, or EXPORTs, or forward references
-               to MODULES
+       /*      Called at scope closing. Check all definitions, and if one
+               is a D_PROCHEAD, the procedure was not defined
        */
-       register struct scope *sc = CurrentScope;
-       register struct def *df, *dfback = 0;
-
-       assert(sc != 0);
-       DO_DEBUG(1, debug("Closing a scope"));
-
-       if (flag) {
-               if (sc->sc_forw) rem_forwards(sc->sc_forw);
-               df = sc->sc_def;
-               while(df) {
-                       if (flag & SC_CHKPROC) {
-                               if (df->df_kind == D_PROCHEAD) {
-                                       /* A not defined procedure
-                                       */
+       while (df) {
+               if (df->df_kind == D_PROCHEAD) {
+                       /* A not defined procedure
+                       */
 node_error(df->for_node, "procedure \"%s\" not defined", df->df_idf->id_text);
-                                       FreeNode(df->for_node);
-                               }
+                       FreeNode(df->for_node);
+               }
+               df = df->df_nextinscope;
+       }
+}
+
+static
+chk_forw(pdf)
+       register 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
+               them, and otherwise move them to the enclosing scope.
+       */
+       while (*pdf) {
+               if ((*pdf)->df_kind & (D_FORWARD|D_FORWMODULE)) {
+                       /* These definitions must be found in
+                          the enclosing closed scope, which of course
+                          may be the scope that is now closed!
+                       */
+                       struct def *df1 = (*pdf)->df_nextinscope;
+
+                       if (scopeclosed(CurrentScope)) {
+                               /* Indeed, the scope was a closed
+                                  scope, so give error message
+                               */
+node_error((*pdf)->for_node, "identifier \"%s\" has not been declared",
+(*pdf)->df_idf->id_text);
+                               FreeNode((*pdf)->for_node);
+                               pdf = &(*pdf)->df_nextinscope;
                        }
-                       if ((flag & SC_CHKFORW) && 
-                           df->df_kind & (D_FORWARD|D_FORWMODULE)) {
-                               /* These definitions must be found in
-                                  the enclosing closed scope, which of course
-                                  may be the scope that is now closed!
+                       else {  /* This scope was an open scope.
+                                  Maybe the definitions are in the
+                                  enclosing scope?
                                */
-                               struct def *df1 = df->df_nextinscope;
-
-                               if (scopeclosed(CurrentScope)) {
-                                       /* Indeed, the scope was a closed
-                                          scope, so give error message
-                                       */
-node_error(df->for_node, "identifier \"%s\" not declared", df->df_idf->id_text);
-                                       FreeNode(df->for_node);
-                                       dfback = df;
-                               }
-                               else {
-                                       /* This scope was an open scope.
-                                          Maybe the definitions are in the
-                                          enclosing scope?
-                                       */
-                                       struct scope *sc;
-
-                                       sc = enclosing(CurrentScope);
-                                       df->df_nextinscope = sc->sc_def;
-                                       sc->sc_def = df;
-                                       df->df_scope = sc->sc_scope;
-                                       if (dfback) dfback->df_nextinscope = df1;
-                                       else sc->sc_def = df1;
+                               struct scope *sc;
+
+                               sc = enclosing(CurrentScope);
+                               if ((*pdf)->df_kind == D_FORWMODULE) {
+                                       (*pdf)->for_scope->next = sc;
                                }
-                               df = df1;
-                       }
-                       else {
-                               dfback = df;
-                               df = df->df_nextinscope;
+                               (*pdf)->df_nextinscope = sc->sc_def;
+                               sc->sc_def = *pdf;
+                               (*pdf)->df_scope = sc;
+                               *pdf = df1;
                        }
                }
+               else    pdf = &(*pdf)->df_nextinscope;
        }
-
-       if (sc->next && (sc->next->sc_scope == 0)) {
-               sc = sc->next;
-       }
-       CurrentScope = sc->next;
 }
 
 static
@@ -182,3 +160,35 @@ rem_forwards(fo)
                free_forwards(f);
        }
 }
+
+close_scope(flag)
+{
+       /*      Close a scope. If "flag" is set, check for forward declarations,
+               either POINTER declarations, or EXPORTs, or forward references
+               to MODULES
+       */
+       register struct scope *sc = CurrentScope;
+
+       assert(sc != 0);
+       DO_DEBUG(1, debug("Closing a scope"));
+
+       if (flag) {
+               if (sc->sc_forw) rem_forwards(sc->sc_forw);
+               DO_DEBUG(2, PrScopeDef(sc->sc_def));
+               if (flag & SC_CHKPROC) chk_proc(sc->sc_def);
+               if (flag & SC_CHKFORW) chk_forw(&(sc->sc_def));
+       }
+       CurrentScope = sc->next;
+}
+
+#ifdef DEBUG
+PrScopeDef(df)
+       register struct def *df;
+{
+       debug("List of definitions in currently ended scope:");
+       while (df) {
+               PrDef(df);
+               df = df->df_nextinscope;
+       }
+}
+#endif
index e009ccf..3dc7b44 100644 (file)
@@ -16,16 +16,15 @@ struct scope {
        struct scope *next;
        struct forwards *sc_forw;
        struct def *sc_def;     /* list of definitions in this scope */
-       int sc_scope;           /* The scope number. Scope number 0 indicates
-                                  both the pervasive scope and the end of a
-                                  visibility range
-                               */
+       arith sc_off;           /* offsets of variables in this scope */
+       char sc_scopeclosed;    /* flag indicating closed or open scope */
 };
 
 extern struct scope
        *CurrentScope,
+       *PervasiveScope,
        *GlobalScope;
 
-#define nextvisible(x) ((x)->sc_scope ? (x)->next : (struct scope *) 0)
-#define scopeclosed(x) ((x)->next->sc_scope == 0)
-#define enclosing(x)   (scopeclosed(x) ? (x)->next->next : (x)->next)
+#define enclosing(x)   ((x)->next)
+#define scopeclosed(x) ((x)->sc_scopeclosed)
+#define nextvisible(x) (scopeclosed(x) ? PervasiveScope : enclosing(x))
index d9eb42c..36596be 100644 (file)
@@ -6,12 +6,15 @@ static char *RcsId = "$Header$";
 #include       <em_arith.h>
 #include       "LLlex.h"
 #include       "node.h"
+
+static int     loopcount = 0;  /* Count nested loops */
 }
 
-statement
+statement(struct node **pnd;)
 {
-       struct node *nd1, *nd2 = 0;
+       struct node *nd1;
 } :
+                               { *pnd = 0; }
 [
        /*
         * This part is not in the reference grammar. The reference grammar
@@ -19,38 +22,45 @@ statement
         * but this gives LL(1) conflicts
         */
        designator(&nd1)
-       [
-               ActualParameters(&nd2)?
-                               { nd1 = MkNode(Call, nd1, nd2, &dot);
+       [                       { nd1 = MkNode(Call, nd1, NULLNODE, &dot);
                                  nd1->nd_symb = '(';
                                }
+               ActualParameters(&(nd1->nd_right))?
        |
                BECOMES         { nd1 = MkNode(Stat, nd1, NULLNODE, &dot); }
                expression(&(nd1->nd_right))
        ]
+                               { *pnd = nd1; }
        /*
         * end of changed part
         */
 |
-       IfStatement
+       IfStatement(pnd)
 |
-       CaseStatement
+       CaseStatement(pnd)
 |
-       WhileStatement
+       WhileStatement(pnd)
 |
-       RepeatStatement
+       RepeatStatement(pnd)
 |
-       LoopStatement
+                       { loopcount++; }
+       LoopStatement(pnd)
+                       { loopcount--; }
 |
-       ForStatement
+       ForStatement(pnd)
 |
-       WithStatement
+       WithStatement(pnd)
 |
        EXIT
+                       { if (!loopcount) {
+                               error("EXIT not in a LOOP");
+                         }
+                         *pnd = MkNode(Stat, NULLNODE, NULLNODE, &dot);
+                       }
 |
-       RETURN
+       RETURN          { *pnd = MkNode(Stat, NULLNODE, NULLNODE, &dot); }
        [
-               expression(&nd1)
+               expression(&((*pnd)->nd_right))
        ]?
 ]?
 ;
@@ -67,66 +77,132 @@ ProcedureCall:
 ;
 */
 
-StatementSequence:
-       statement [ ';' statement ]*
+StatementSequence(struct node **pnd;):
+       statement(pnd)
+       [
+               ';'     { *pnd = MkNode(Link, *pnd, NULLNODE, &dot);
+                         pnd = &((*pnd)->nd_right);
+                       }
+               statement(pnd)
+       ]*
 ;
 
-IfStatement
+IfStatement(struct node **pnd;)
 {
-       struct node *nd1;
+       register struct node *nd;
 } :
-       IF expression(&nd1) THEN StatementSequence
-       [ ELSIF expression(&nd1) THEN StatementSequence ]*
-       [ ELSE StatementSequence ]?
+       IF              { nd = MkNode(Stat, NULLNODE, NULLNODE, &dot);
+                         *pnd = nd;
+                       }
+       expression(&(nd->nd_left))
+       THEN            { nd = MkNode(Link, NULLNODE, NULLNODE, &dot);
+                         (*pnd)->nd_right = nd;
+                       }
+       StatementSequence(&(nd->nd_left))
+       [
+               ELSIF   { nd->nd_right = MkNode(Stat,NULLNODE,NULLNODE,&dot);
+                         nd = nd->nd_right;
+                         nd->nd_symb = IF;
+                       }
+               expression(&(nd->nd_left))
+               THEN    { nd->nd_right = MkNode(Link,NULLNODE,NULLNODE,&dot);
+                         nd = nd->nd_right;
+                       }
+               StatementSequence(&(nd->nd_left))
+       ]*
+       [
+               ELSE
+               StatementSequence(&(nd->nd_right))
+       ]?
        END
 ;
 
-CaseStatement
+CaseStatement(struct node **pnd;)
 {
-       struct node *nd;
+       register struct node *nd;
+       struct type *tp = 0;
 } :
-       CASE expression(&nd) OF case [ '|' case ]*
-       [ ELSE StatementSequence ]?
+       CASE            { *pnd = nd = MkNode(Stat, NULLNODE, NULLNODE, &dot); }
+       expression(&(nd->nd_left))
+       OF
+       case(&(nd->nd_right), &tp)
+                       { nd = nd->nd_right; }
+       [
+               '|'
+               case(&(nd->nd_right), &tp)
+                       { nd = nd->nd_right; }
+       ]*
+       [ ELSE StatementSequence(&(nd->nd_right)) ]?
        END
 ;
 
-case:
-       [ CaseLabelList ':' StatementSequence ]?
+case(struct node **pnd; struct type **ptp;) :
+                       { *pnd = 0; }
+       [ CaseLabelList(ptp/*,pnd*/)
+         ':'           { *pnd = MkNode(Link, *pnd, NULLNODE, &dot); }
+         StatementSequence(&((*pnd)->nd_right))
+       ]?
                                /* This rule is changed in new modula-2 */
+                       { *pnd = MkNode(Link, *pnd, NULLNODE, &dot);
+                         (*pnd)->nd_symb = '|';
+                       }
 ;
 
-WhileStatement
+WhileStatement(struct node **pnd;)
 {
-       struct node *nd;
+       register struct node *nd;
 }:
-       WHILE expression(&nd) DO StatementSequence END
+       WHILE           { *pnd = nd = MkNode(Stat, NULLNODE, NULLNODE, &dot); }
+       expression(&(nd->nd_left))
+       DO
+       StatementSequence(&(nd->nd_right))
+       END
 ;
 
-RepeatStatement
+RepeatStatement(struct node **pnd;)
 {
-       struct node *nd;
+       register struct node *nd;
 }:
-       REPEAT StatementSequence UNTIL expression(&nd)
+       REPEAT          { *pnd = nd = MkNode(Stat, NULLNODE, NULLNODE, &dot); }
+       StatementSequence(&(nd->nd_left))
+       UNTIL
+       expression(&(nd->nd_right))
 ;
 
-ForStatement
+ForStatement(struct node **pnd;)
 {
-       struct node *nd1, *nd2, *nd3;
+       register struct node *nd;
 }:
-       FOR IDENT
-       BECOMES expression(&nd1)
-       TO expression(&nd2)
-       [ BY ConstExpression(&nd3) ]?
-       DO StatementSequence END
+       FOR             { *pnd = MkNode(Stat, NULLNODE, NULLNODE, &dot); }
+       IDENT           { nd = MkNode(Name, NULLNODE, NULLNODE, &dot); }
+       BECOMES         { nd = MkNode(BECOMES, nd, NULLNODE, &dot); }
+       expression(&(nd->nd_right))
+       TO              { (*pnd)->nd_left=nd=MkNode(Link,nd,NULLNODE,&dot); }
+       expression(&(nd->nd_right))
+       [
+               BY      { nd->nd_right=MkNode(Link,NULLNODE,nd->nd_right,&dot);
+                       }
+               ConstExpression(&(nd->nd_right->nd_left))
+       |
+       ]
+       DO
+       StatementSequence(&((*pnd)->nd_right))
+       END
 ;
 
-LoopStatement:
-       LOOP StatementSequence END
+LoopStatement(struct node **pnd;):
+       LOOP            { *pnd = MkNode(Stat, NULLNODE, NULLNODE, &dot); }
+       StatementSequence(&((*pnd)->nd_right))
+       END
 ;
 
-WithStatement
+WithStatement(struct node **pnd;)
 {
-       struct node *nd;
+       register struct node *nd;
 }:
-       WITH designator(&nd) DO StatementSequence END
+       WITH            { *pnd = nd = MkNode(Stat, NULLNODE, NULLNODE, &dot); }
+       designator(&(nd->nd_left))
+       DO
+       StatementSequence(&(nd->nd_right))
+       END
 ;
index 8abf698..38c8a96 100644 (file)
@@ -38,8 +38,8 @@ struct array {
 };
 
 struct record {
-       int rc_scope;           /* Scope number of this record */
-                               /* Members are in the symbol table */
+       struct scope *rc_scope; /* scope of this record */
+                               /* members are in the symbol table */
 #define rec_scope      tp_value.tp_record.rc_scope
 };
 
@@ -71,6 +71,7 @@ struct type   {
 #define T_INTORCARD    (T_INTEGER|T_CARDINAL)
 #define T_DISCRETE     (T_ENUMERATION|T_INTORCARD|T_CHAR)
 #define T_NUMERIC      (T_INTORCARD|T_REAL)
+#define T_INDEX                (T_ENUMERATION|T_CHAR|T_SUBRANGE)
        int tp_align;           /* alignment requirement of this type */
        arith tp_size;          /* size of this type */
        union {
index 7efa40a..5792379 100644 (file)
@@ -151,24 +151,6 @@ init_types()
        error_type = standard_type(T_CHAR, 1, (arith) 1);
 }
 
-int
-has_selectors(df)
-       register struct def *df;
-{
-
-       switch(df->df_kind) {
-       case D_MODULE:
-               return df->df_value.df_module.mo_scope;
-       case D_VARIABLE:
-               if (df->df_type->tp_fund == T_RECORD) {
-                       return df->df_type->rec_scope;
-               }
-               break;
-       }
-       error("no selectors for \"%s\"", df->df_idf->id_text);
-       return 0;
-}
-
 /*     Create a parameterlist of a procedure and return a pointer to it.
        "ids" indicates the list of identifiers, "tp" their type, and
        "VARp" is set when the parameters are VAR-parameters.
@@ -226,6 +208,8 @@ chk_basesubrange(tp, base)
                error("Specified base does not conform");
        }
        tp->next = base;
+       tp->tp_size = base->tp_size;
+       tp->tp_align = base->tp_align;
 }
 
 struct type *
@@ -236,7 +220,7 @@ subr_type(lb, ub)
                indicated by "lb" and "ub", but first perform some
                checks
        */
-       register struct type *tp = lb->nd_type;
+       register struct type *tp = lb->nd_type, *res;
 
        if (!TstCompat(lb->nd_type, ub->nd_type)) {
                node_error(ub, "Types of subrange bounds not compatible");
@@ -264,11 +248,13 @@ subr_type(lb, ub)
 
        /* Now construct resulting type
        */
-       tp = construct_type(T_SUBRANGE, tp);
-       tp->sub_lb = lb->nd_INT;
-       tp->sub_ub = ub->nd_INT;
+       res = construct_type(T_SUBRANGE, tp);
+       res->sub_lb = lb->nd_INT;
+       res->sub_ub = ub->nd_INT;
+       res->tp_size = tp->tp_size;
+       res->tp_align = tp->tp_align;
        DO_DEBUG(2,debug("Creating subrange type %ld-%ld", (long)lb->nd_INT,(long)ub->nd_INT));
-       return tp;
+       return res;
 }
 #define MAX_SET        1024    /* ??? Maximum number of elements in a set */
 
@@ -302,3 +288,71 @@ set_type(tp)
        tp->tp_size = align(((ub - lb) + 7)/8, wrd_align);
        return tp;
 }
+
+ArraySizes(tp)
+       register struct type *tp;
+{
+       /*      Assign sizes to an array type
+       */
+       arith elem_size;
+       register struct type *itype = tp->next; /* the index type */
+
+       if (tp->arr_elem->tp_fund == T_ARRAY) {
+               ArraySizes(tp->arr_elem);
+       }
+
+       elem_size = align(tp->arr_elem->tp_size, tp->arr_elem->tp_align);
+       tp->tp_align = tp->arr_elem->tp_align;
+
+       if (! (itype->tp_fund & T_INDEX)) {
+               error("Illegal index type");
+               tp->tp_size = 0;
+               return;
+       }
+
+       switch(itype->tp_fund) {
+       case T_SUBRANGE:
+               tp->arr_lb = itype->sub_lb;
+               tp->arr_ub = itype->sub_ub;
+               tp->tp_size = elem_size * (itype->sub_ub - itype->sub_lb + 1);
+               break;
+       case T_CHAR:
+       case T_ENUMERATION:
+               tp->arr_lb = 0;
+               tp->arr_ub = itype->enm_ncst - 1;
+               tp->tp_size = elem_size * itype->enm_ncst;
+               break;
+       default:
+               assert(0);
+       }
+       /* ??? overflow checking ??? */
+}
+
+int
+gcd(m, n)
+       register int m, n;
+{
+       /*      Greatest Common Divisor
+       */
+       register int r;
+
+       while (n)       {
+               r = m % n;
+               m = n;
+               n = r;
+       }
+       return m;
+}
+
+int
+lcm(m, n)
+       register int m, n;
+{
+       /*      Least Common Multiple
+       */
+       while (m != n) {
+               if (m < n) m = m + m;
+               else n = n + n;
+       }
+       return n;               /* or m */
+}
index 9c97fdd..7fef092 100644 (file)
@@ -2,6 +2,9 @@
 
 static char *RcsId = "$Header$";
 
+/*     Routines for testing type equivalence, type compatibility, and
+       assignment compatibility
+*/
 #include       <em_arith.h>
 #include       <em_label.h>
 #include       "type.h"
@@ -15,8 +18,8 @@ TstTypeEquiv(tp1, tp2)
                from the fact that for some procedures two declarations may
                be given: one in the specification module and one in the
                definition module.
-               A related problem is that two dynamic arrays with the
-               same base type are also equivalent.
+               A related problem is that two dynamic arrays with
+               equivalent base types are also equivalent.
        */
 
        return     tp1 == tp2
@@ -66,8 +69,7 @@ TstProcEquiv(tp1, tp2)
                p1 = p1->next;
                p2 = p2->next;
        }
-       if (p1 != p2) return 0;
-       return 1;
+       return p1 == p2;
 }
 
 int