Newer version, safety commit
authorceriel <none@none>
Sat, 29 Mar 1986 01:04:49 +0000 (01:04 +0000)
committerceriel <none@none>
Sat, 29 Mar 1986 01:04:49 +0000 (01:04 +0000)
lang/m2/comp/Makefile
lang/m2/comp/declar.g
lang/m2/comp/def.H
lang/m2/comp/def.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.h
lang/m2/comp/type.H
lang/m2/comp/type.c

index d8a5804..ef03535 100644 (file)
@@ -74,8 +74,8 @@ symbol2str.o: Lpars.h
 tokenname.o: Lpars.h idf.h tokenname.h
 idf.o: idf.h
 input.o: f_info.h input.h
-type.o: Lpars.h def.h def_sizes.h idf.h type.h
-def.o: Lpars.h debug.h def.h idf.h main.h scope.h
+type.o: Lpars.h def.h def_sizes.h idf.h misc.h type.h
+def.o: Lpars.h debug.h def.h idf.h main.h misc.h scope.h
 scope.o: LLlex.h debug.h def.h idf.h scope.h type.h
 misc.o: LLlex.h f_info.h idf.h misc.h
 enter.o: def.h idf.h misc.h scope.h type.h
index 3989bb6..f6c492e 100644 (file)
@@ -31,13 +31,17 @@ ProcedureHeading(struct def **pdf; int type;)
        struct paramlist *params = 0;
 } :
        PROCEDURE IDENT
-                       { assert(type == D_PROCEDURE || type == D_PROCHEAD);
+                       { assert(type & (D_PROCEDURE | D_PROCHEAD));
                          *pdf = define(dot.TOK_IDF, CurrentScope, type);
                          if (type == D_PROCEDURE) {
                                open_scope(OPENSCOPE, 0);
                          }
                        }
        FormalParameters(type, &params, &tp)?
+                       {
+                         (*pdf)->df_type = tp = construct_type(PROCEDURE, tp);
+                         tp->prc_params = params;
+                       }
 ;
 
 block:
@@ -63,54 +67,47 @@ FormalParameters(int doparams; struct paramlist **pr; struct type **tp;)
 } :
        '('
        [
-               FPSection(doparams, pr)
+               FPSection(doparams, pr) 
+                       { pr1 = *pr; }
                [
-                       { for (pr1 = *pr; pr1->next; pr1 = pr1->next) ; }
+                       { for (; pr1->next; pr1 = pr1->next) ; }
                        ';' FPSection(doparams, &(pr1->next))
                ]*
        ]?
        ')'
                        { *tp = 0; }
-       [ ':' qualident(D_TYPE | D_HTYPE, &df, "type")
-                       { /* ???? *tp = df->df_type; */ }
+       [       ':' qualident(D_TYPE | D_HTYPE, &df, "type")
+                       { *tp = df->df_type; }
        ]?
 ;
 
+/*     In the next nonterminal, "doparams" is a flag indicating whether
+       the identifiers representing the parameters must be added to the
+       symbol table. We must not do so when reading a Definition Module,
+       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;)
 {
        struct id_list *FPList;
-       register struct id_list *pid;
-       register struct paramlist *pr = 0;
-       int VARflag = 0;
+       struct paramlist *ParamList();
+       struct type *tp;
+       int VARp = 0;
 } :
        [
-               VAR     { VARflag = 1; }
+               VAR     { VARp = 1; }
        ]?
-       IdentList(&FPList) ':' FormalType
-                       {
-                         if (doparams) {
-                               EnterIdList(FPList,
-                                           D_VARIABLE,
-                                           VARflag,
-                                           (struct type *) 0   /* ???? */,
-                                           CurrentScope
-                               );
-                         }
-                         *ppr = pr = new_paramlist();
-                         pr->par_type = 0;     /* ??? */
-                         pr->par_var = VARflag;
-                         for (pid = FPList->next; pid; pid = pid->next) {
-                               pr->next = new_paramlist();
-                               pr = pr->next;
-                               pr->par_type = 0;       /* ??? */
-                               pr->par_var = VARflag;
-                         }
-                         pr->next = 0;
-                         FreeIdList(FPList);
-                       }
+       IdentList(&FPList) ':' FormalType(&tp)
+               {
+                 if (doparams) {
+                       EnterIdList(FPList, D_VARIABLE, VARp, tp, CurrentScope);
+                 }
+                 *ppr = ParamList(FPList, tp);
+                 FreeIdList(FPList);
+               }
 ;
 
-FormalType
+FormalType(struct type **tp;)
 {
        struct def *df;
        int ARRAYflag = 0;
@@ -118,6 +115,12 @@ FormalType
        [ ARRAY OF      { ARRAYflag = 1; }
        ]?
        qualident(D_TYPE | D_HTYPE, &df, "type")
+                       { if (ARRAYflag) {
+                               *tp = construct_type(ARRAY, NULLTYPE);
+                               (*tp)->arr_elem = df->df_type;
+                         }
+                         else  *tp = df->df_type;
+                       }
 ;
 
 TypeDeclaration
@@ -127,8 +130,7 @@ TypeDeclaration
 }:
        IDENT           { df = define(dot.TOK_IDF, CurrentScope, D_TYPE); }
        '=' type(&tp)
-                       { df->df_type = tp;
-                       }
+                       { df->df_type = tp; }
 ;
 
 type(struct type **ptp;):
@@ -148,17 +150,19 @@ type(struct type **ptp;):
 SimpleType(struct type **ptp;)
 {
        struct def *df;
+       struct type *tp;
 } :
        qualident(D_TYPE | D_HTYPE, &df, "type")
        [
-
+               /* nothing */
        |
                SubrangeType(ptp)
-               /*
-                * The subrange type is given a base type by the
-                * qualident (this is new modula-2).
-                */
-                       { /* ???? (*ptp)->next = df->df_type; */ }
+               /* The subrange type is given a base type by the
+                  qualident (this is new modula-2).
+               */
+                       {
+                         chk_basesubrange(*ptp, tp);
+                       }
        ]
 |
        enumeration(ptp)
@@ -228,11 +232,11 @@ ArrayType(struct type **ptp;)
                        }
        [
                ',' SimpleType(&tp)
-                       { tp2 = tp2->tp_value.tp_arr.ar_elem = 
+                       { tp2 = tp2->arr_elem = 
                                construct_type(ARRAY, tp);
                        }
        ]* OF type(&tp)
-                       { tp2->tp_value.tp_arr.ar_elem = tp; }
+                       { tp2->arr_elem = tp; }
 ;
 
 RecordType(struct type **ptp;)
@@ -245,7 +249,7 @@ RecordType(struct type **ptp;)
        FieldListSequence(scopenr)
                        {
                          *ptp = standard_type(RECORD, record_align, (arith) 0 /* ???? */);
-                         (*ptp)->tp_value.tp_record.rc_scopenr = scopenr;
+                         (*ptp)->rec_scopenr = scopenr;
                        }
        END
 ;
@@ -310,48 +314,87 @@ SetType(struct type **ptp;)
                        }
 ;
 
+/*     In a pointer type definition, the type pointed at does not
+       have to be declared yet, so be careful about identifying
+       type-identifiers
+*/
 PointerType(struct type **ptp;)
 {
        struct type *tp;
-       register struct def *df;
+       struct def *df;
        struct def *lookfor();
 } :
        POINTER TO
        [ %if ( (df = lookup(dot.TOK_IDF, CurrentScope)))
-               IDENT
+               /* Either a Module or a Type, but in both cases defined
+                  in this scope, so this is the correct identification
+               */
+               qualident(D_TYPE|D_HTYPE, &df, "type")
                                {
-                                 if (!(df->df_kind & (D_TYPE | D_HTYPE))) {
-                                       error("\"%s\" is not a type identifier",
-                                               df->df_idf->id_text);
-                                 }
                                  if (!df->df_type) {
                                        error("type \"%s\" not declared",
                                                df->df_idf->id_text);
+                                       tp = error_type;
                                  }
-                                 *ptp = df->df_type;
+                                 else  tp = df->df_type;
                                }
        | %if (df = lookfor(dot.TOK_IDF, 0), df->df_kind == D_MODULE)
                type(&tp)
-                               { *ptp = construct_type(POINTER, tp); }
        |
                IDENT
-                               { *ptp = construct_type(POINTER, NULLTYPE);
-                                 Forward(&dot, &((*ptp)->next));
-                               }
+                               { tp = NULLTYPE; }
        ]
+                               {
+                                 *ptp = construct_type(POINTER, tp);
+                                 if (!tp) Forward(&dot, &((*ptp)->next));
+                               }
 ;
 
-ProcedureType(struct type **ptp;):
-       PROCEDURE FormalTypeList?
-                       { *ptp = 0; }
+ProcedureType(struct type **ptp;)
+{
+       struct paramlist *pr = 0;
+       struct type *tp = 0;
+} :
+       PROCEDURE FormalTypeList(&pr, &tp)?
+                       { *ptp = construct_type(PROCEDURE, tp);
+                         (*ptp)->prc_params = pr;
+                       }
 ;
 
-FormalTypeList
+FormalTypeList(struct paramlist **ppr; struct type **ptp;)
 {
        struct def *df;
+       struct type *tp;
+       struct paramlist *p;
+       int VARp;
 } :
-       '(' [ VAR? FormalType [ ',' VAR? FormalType ]* ]? ')'
-       [ ':' qualident(1, &df, "type")
+       '('             { *ppr = 0; }
+       [
+               [ VAR   { VARp = 1; }
+               |       { VARp = 0; }
+               ]
+               FormalType(&tp)
+                       { *ppr = p = new_paramlist();
+                         p->par_type = tp;
+                         p->par_var = VARp;
+                       }
+               [
+                       ','
+                       [ VAR   {VARp = 1; }
+                       |       {VARp = 0; }
+                       ] 
+                       FormalType(&tp)
+                               { p->next = new_paramlist();
+                                 p = p->next;
+                                 p->par_type = tp;
+                                 p->par_var = VARp;
+                               }
+               ]*
+                               { p->next = 0; }
+       ]?
+       ')'
+       [ ':' qualident(D_TYPE|D_HTYPE, &df, "type")
+                               { *ptp = df->df_type; }
        ]?
 ;
 
index 24abd79..49d5bc0 100644 (file)
@@ -5,48 +5,58 @@
 struct module {
        int mo_priority;        /* Priority of a module */
        int 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 {
-       char va_fixedaddress;   /* Flag, set if an address was given */
        arith va_off;           /* Address or offset of variable */
+#define var_off                df_value.df_variable.va_off
 };
 
 struct constant {
-       struct expr *co_const;  /* A constant expression */
+       arith co_const;         /* result of a constant expression */
+#define con_const      df_value.df_variable.con_const
 };
 
 struct enumval {
        unsigned int en_val;    /* Value of this enumeration literal */
        struct def *en_next;    /* Next enumeration literal */
+#define enm_val                df_value.df_enum.en_val
+#define enm_next       df_value.df_enum.en_next
 };
 
 struct field {
-       arith fld_off;
+       arith fd_off;
        struct variant {
-               struct caselabellist *fld_cases;
-               label fld_casedescr;
-               struct def *fld_varianttag;
-       } *fld_variant;
+               struct caselabellist *v_cases;
+               label v_casedescr;
+               struct def *v_varianttag;
+       } *fd_variant;
+#define fld_off                df_value.df_field.fd_off
+#define fld_variant    df_value.df_field.fd_variant
 };
 
 struct import {
        int im_scopenr;         /* Scope number from which imported */
+#define imp_scopenr    df_value.df_import.im_scopenr
 };
 
 struct def     {               /* list of definitions for a name */
-       struct def *next;
+       struct def *next;       /* next definition in definitions chain */
+       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 */
        short df_kind;          /* The kind of this definition: */
-#define D_MODULE       0x0001
-#define D_PROCEDURE    0x0002
-#define D_VARIABLE     0x0004
-#define D_FIELD                0x0008
-#define D_TYPE         0x0010
-#define D_ENUM         0x0020
-#define D_CONST                0x0040
-#define D_IMPORT       0x0080
+#define D_MODULE       0x0001  /* A module */
+#define D_PROCEDURE    0x0002  /* Procedure of function */
+#define D_VARIABLE     0x0004  /* A variable */
+#define D_FIELD                0x0008  /* A field in a record */
+#define D_TYPE         0x0010  /* A type */
+#define D_ENUM         0x0020  /* An enumeration literal */
+#define D_CONST                0x0040  /* A constant */
+#define D_IMPORT       0x0080  /* An imported definition */
 #define D_PROCHEAD     0x0100  /* A procedure heading in a definition module */
 #define D_HIDDEN       0x0200  /* A hidden type */
 #define D_HTYPE                0x0400  /* Definition of a hidden type seen */
index 5a815e9..2d4bfc2 100644 (file)
@@ -5,9 +5,11 @@ static char *RcsId = "$Header$";
 #include       <alloc.h>
 #include       <em_arith.h>
 #include       <em_label.h>
+#include       <assert.h>
 #include       "Lpars.h"
 #include       "def.h"
 #include       "idf.h"
+#include       "misc.h"
 #include       "main.h"
 #include       "scope.h"
 #include       "debug.h"
@@ -15,7 +17,7 @@ static char *RcsId = "$Header$";
 struct def *h_def;             /* Pointer to free list of def structures */
 
 static struct def illegal_def =
-       {0, 0, -20 /* Illegal scope */, D_ERROR};
+       {0, 0, 0, -20 /* Illegal scope */, D_ERROR};
 
 struct def *ill_df = &illegal_def;
 
@@ -27,6 +29,7 @@ define(id, scope, kind)
                already has been defined. If so, error message.
        */
        register struct def *df;
+       register struct scope *sc;
 
        DO_DEBUG(debug(4,"Defining identifier %s in scope %d", id->id_text, scope));
        df = lookup(id, scope);
@@ -66,6 +69,15 @@ define(id, scope, kind)
        df->df_kind = kind;
        df->next = id->id_def;
        id->id_def = df;
+
+       /* enter the definition in the list of definitions in this scope */
+       sc = currscope;
+       while (sc->sc_scope != scope) {
+               sc = sc->next;
+               assert(sc != 0);
+       }
+       df->df_nextinscope = sc->sc_def;
+       sc->sc_def = df;
        return df;
 }
 
@@ -85,6 +97,14 @@ lookup(id, scope)
        DO_DEBUG(debug(4,"Looking for identifier %s in scope %d", id->id_text, scope));
        while (df) {
                if (df->df_scope == scope) {
+                       if (df->df_kind == D_IMPORT) {
+                               df = lookup(id, df->imp_scopenr);
+                               assert(df != 0);
+                               return df;
+                               /* ??? But this does damage to the self-
+                                  organizing character of the list
+                               */
+                       }
                        if (df1) {
                                df1->next = df->next;
                                df->next = id->id_def;
@@ -97,3 +117,78 @@ lookup(id, scope)
        }
        return 0;
 }
+
+/*     From the current scope, the list of identifiers "ids" is
+       exported. Note this fact. If the export is not qualified, make
+       all the "ids" visible in the enclosing scope by defining them
+       in this scope as "imported".
+*/
+Export(ids, qualified)
+       register struct id_list *ids;
+{
+       register struct def *df;
+
+       while (ids) {
+               df = define(ids->id_ptr, CurrentScope, D_ISEXPORTED);
+               if (qualified) {
+                       df->df_flags |= D_QEXPORTED;
+               }
+               else {
+                       df->df_flags |= D_EXPORTED;
+                       df = define(ids->id_ptr, enclosing(currscope)->sc_scope,
+                                       D_IMPORT);
+               }
+               ids = ids->next;
+       }
+}
+
+/*     "ids" is a list of imported identifiers.
+       If "id" is a null-pointer, the identifiers are imported from the
+       enclosing scope. Otherwise they are imported from the module
+       indicated by "id", ehich must be visible in the enclosing scope.
+       An exception must be made for imports of the Compilation Unit.
+       This case is indicated by  the value 0 of the flag "local".
+       In this case, if "id" is a null pointer, the "ids" identifiers
+       are all module identifiers. Their Definition Modules must be read.
+       Otherwise "id" is a module identifier whose Definition Module must
+       be read. "ids" then represents a list of identifiers defined in
+       this module.
+*/
+Import(ids, id, local)
+       register struct id_list *ids;
+       struct idf *id;
+{
+       register struct def *df;
+       int scope;
+       int kind;
+       struct def *lookfor();
+
+       if (local) {
+               kind = D_IMPORT;
+               if (!id) scope = enclosing(currscope)->sc_scope;
+               else {
+                       df = lookfor(id, 1);
+                       if (df->df_kind != D_MODULE) {
+                               if (df->df_kind != D_ERROR) {
+error("identifier \"%s\" does not represent a module", id->id_text);
+                               }
+                               /* enter all "ids" with type D_ERROR */
+                               kind = D_ERROR;
+                               scope = enclosing(currscope)->sc_scope;
+                       }
+                       else    scope = df->mod_scope;
+               }
+               while (ids) {
+                       df = lookup(ids->id_ptr, scope);
+                       if (!df) {
+                               error("identifier \"%s\" not declared",
+                                     ids->id_ptr->id_text);
+                       }
+                       df = define(ids->id_ptr, CurrentScope, D_IMPORT);
+                       df->imp_scopenr = scope;
+                       ids = ids->next;
+               }
+               return;
+       }
+       /* ???? */
+}
index d5c1322..03b9833 100644 (file)
@@ -55,8 +55,8 @@ EnterIdList(idlist, kind, flags, type, scope)
        if (last) {
                /* Also meaning : enumeration */
                last->df_value.df_enum.en_next = 0;
-               type->tp_value.tp_enum.en_enums = first;
-               type->tp_value.tp_enum.en_ncst = assval;
+               type->enm_enums = first;
+               type->enm_ncst = assval;
        }
 }
 
index 38c08a7..9d43579 100644 (file)
@@ -25,11 +25,8 @@ qualident(int types; struct def **pdf; char *str;)
        struct def *lookfor();
 } :
        IDENT           { if (types) {
-                               df = lookfor(dot.TOK_IDF, 1);
-                               if (df->df_kind == D_ERROR) {
-                                       *pdf = df;
-                                       types = 0;
-                               }
+                               *pdf = df = lookfor(dot.TOK_IDF, 1);
+                               if (df->df_kind == D_ERROR) types = 0;
                          }
                        }
        [
@@ -53,7 +50,7 @@ qualident(int types; struct def **pdf; char *str;)
        ]*
                        { if (types && !(types & df->df_kind)) {
                                error("identifier \"%s\" is not a %s",
-                                       dot.TOK_IDF, str);
+                                       df->df_idf->id_text, str);
                          }
                        }
 ;
index 7ff75ed..2bd33a0 100644 (file)
@@ -158,8 +158,8 @@ add_standards()
                     construct_type(PROCEDURE, NULLTYPE),
                     0);
        tp = construct_type(SUBRANGE, int_type);
-       tp->tp_value.tp_subrange.su_lb = 0;
-       tp->tp_value.tp_subrange.su_ub = wrd_size * 8 - 1;
+       tp->sub_lb = 0;
+       tp->sub_ub = wrd_size * 8 - 1;
        df = Enter("BITSET", D_TYPE, construct_type(SET, tp), 0);
        df->df_type->tp_size = wrd_size;
        df = Enter("FALSE", D_ENUM, bool_type, 0);
index 77751d7..691b08c 100644 (file)
@@ -32,8 +32,20 @@ static  char *RcsId = "$Header$";
 
 %start CompUnit, CompilationUnit;
 
-ModuleDeclaration:
-       MODULE IDENT priority? ';' import(1)* export? block IDENT
+ModuleDeclaration
+{
+       struct idf *id;
+} :
+       MODULE IDENT            { open_scope(CLOSEDSCOPE, 0);
+                                 id = dot.TOK_IDF;
+                               }
+       priority? ';'
+       import(1)*
+       export?
+       block
+       IDENT                   { close_scope();
+                                 match_id(id, dot.TOK_IDF);
+                               }
 ;
 
 priority:
@@ -51,6 +63,7 @@ export
        ]?
        IdentList(&ExportList) ';'
                        {
+                         Export(ExportList, QUALflag);
                          FreeIdList(ExportList);
                        }
 ;
@@ -71,6 +84,7 @@ import(int local;)
           name, otherwise the names in the import list are module names.
        */
                        {
+                         Import(ImportList, id, local);
                          FreeIdList(ImportList);
                        }
 ;
@@ -78,12 +92,13 @@ import(int local;)
 DefinitionModule
 {
        struct def *df;
+       struct idf *id;
 } :
        DEFINITION      { state = DEFINITION; }
-       MODULE IDENT    { 
-                         df = define(dot.TOK_IDF, CurrentScope, D_MODULE);
+       MODULE IDENT    { id = dot.TOK_IDF;
+                         df = define(id, CurrentScope, D_MODULE);
                          open_scope(CLOSEDSCOPE, 0);
-                         df->df_value.df_module.mo_scope = CurrentScope;
+                         df->mod_scope = CurrentScope;
                        }
        ';'
        import(0)* 
@@ -92,7 +107,9 @@ DefinitionModule
                New Modula-2 does not have export lists in definition modules.
        */
        definition* END IDENT '.'
-                       { close_scope(); }
+                       { close_scope();
+                         match_id(id, dot.TOK_IDF);
+                       }
 ;
 
 definition
@@ -120,7 +137,9 @@ definition
        ProcedureHeading(&df, D_PROCHEAD) ';'
 ;
 
-ProgramModule:
+ProgramModule {
+       struct idf *id;
+} :
        MODULE          { if (state != IMPLEMENTATION) state = PROGRAM; }
        IDENT           { if (state == IMPLEMENTATION) {
                                /* ????
@@ -128,12 +147,16 @@ ProgramModule:
                                   Look for current identifier,
                                   and find out its scope number
                                */
-                               open_scope(CLOSEDSCOPE, 0);
                          }
-                         else  open_scope(CLOSEDSCOPE, 0);
+                         id = dot.TOK_IDF;
+                         open_scope(CLOSEDSCOPE, 0);
+                       }
+       priority?
+       ';' import(0)*
+       block IDENT
+                       { close_scope();
+                         match_id(id, dot.TOK_IDF);
                        }
-       priority? ';' import(0)* block IDENT
-                       { close_scope(); }
        '.'
 ;
 
index f924b6b..35253be 100644 (file)
@@ -8,6 +8,7 @@
 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
@@ -19,5 +20,5 @@ extern struct scope
 
 #define nextvisible(x) ((x)->sc_scope ? (x)->next : (struct scope *) 0)
 #define scopeclosed(x) ((x)->next->sc_scope == 0)
-#define enclosing(x)   ((x)->next->scope != 0 ? (struct scope *) 0 : (x)->next->next)
+#define enclosing(x)   (scopeclosed(x) ? (x)->next->next : (x)->next)
 #define CurrentScope   (currscope->sc_scope)
index 942fcbf..0f2a2ee 100644 (file)
@@ -14,26 +14,38 @@ struct enume {
        struct def *en_enums;   /* Definitions of enumeration literals */
        unsigned int en_ncst;   /* Number of constants */
        label en_rck;           /* Label of range check descriptor */
+#define enm_enums      tp_value.tp_enum.en_enums
+#define enm_ncst       tp_value.tp_enum.en_ncst
+#define enm_rck                tp_value.tp_enum.enm_rck
 };
 
 struct subrange {
        arith su_lb, su_ub;     /* Lower bound and upper bound */
        label su_rck;           /* Label of range check descriptor */
+#define sub_lb tp_value.tp_subrange.su_lb
+#define sub_ub tp_value.tp_subrange.su_ub
+#define sub_rck        tp_value.tp_subrange.su_rck
 };
 
 struct array {
        struct type *ar_elem;   /* Type of elements */
        arith ar_lb, ar_ub;     /* Lower bound and upper bound */
        label ar_descr;         /* Label of array descriptor */
+#define arr_elem       tp_value.tp_arr.ar_elem
+#define arr_lb         tp_value.tp_arr.ar_lb
+#define arr_ub         tp_value.tp_arr.ar_ub
+#define arr_descr      tp_value.tp_arr.ar_descr
 };
 
 struct record {
        int rc_scopenr;         /* Scope number of this record */
                                /* Members are in the symbol table */
+#define rec_scopenr    tp_value.tp_record.rc_scopenr
 };
 
 struct proc {
        struct paramlist *pr_params;
+#define prc_params     tp_value.tp_proc.pr_params
 };
 
 struct type    {
index a8eb556..ae9aa6f 100644 (file)
@@ -11,6 +11,7 @@ static char *RcsId = "$Header$";
 #include       "def.h"
 #include       "type.h"
 #include       "idf.h"
+#include       "misc.h"
 
 /*     To be created dynamically in main() from defaults or from command
        line parameters.
@@ -143,7 +144,7 @@ has_selectors(df)
                register struct type *tp = df->df_type;
 
                if (tp->tp_fund == RECORD) {
-                       return tp->tp_value.tp_record.rc_scopenr;
+                       return tp->rec_scopenr;
                }
                break;
                }
@@ -151,3 +152,58 @@ has_selectors(df)
        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.
+       Actually, "ids" is only used because it tells us how many parameters
+       there were with this type.
+*/
+struct paramlist *
+ParamList(ids, tp, VARp)
+       register struct id_list *ids;
+       struct type *tp;
+{
+       register struct paramlist *pr;
+       struct paramlist *pstart;
+
+       pstart = pr = new_paramlist();
+       pr->par_type = tp;
+       pr->par_var = VARp;
+       for (ids = ids->next; ids; ids = ids->next) {
+               pr->next = new_paramlist();
+               pr = pr->next;
+               pr->par_type = tp;
+               pr->par_var = VARp;
+       }
+       pr->next = 0;
+       return pstart;
+}
+
+/*     A subrange had a specified base. Check that the bases conform ...
+*/
+chk_basesubrange(tp, base)
+       register struct type *tp, *base;
+{
+       if (base->tp_fund == SUBRANGE) {
+               /* Check that the bounds of "tp" fall within the range
+                  of "base"
+               */
+               if (base->sub_lb > tp->sub_lb || base->sub_ub < tp->sub_ub) {
+                       error("Base type has insufficient range");
+               }
+               base = base->next;
+       }
+       if (base->tp_fund == ENUMERATION || base->tp_fund == CHAR) {
+               if (tp->next != base) {
+                       error("Specified base does not conform");
+               }
+       }
+       else if (base != card_type && base != int_type) {
+               error("Illegal base for a subrange");
+       }
+       else if (base != tp->next && base != int_type) {
+               error("Specified base does not conform");
+       }
+       tp->next = base;
+}