Some minor mods and a bug fix with type transfer functions
authorceriel <none@none>
Thu, 24 Sep 1987 13:07:31 +0000 (13:07 +0000)
committerceriel <none@none>
Thu, 24 Sep 1987 13:07:31 +0000 (13:07 +0000)
15 files changed:
lang/m2/comp/chk_expr.c
lang/m2/comp/code.c
lang/m2/comp/declar.g
lang/m2/comp/def.c
lang/m2/comp/defmodule.c
lang/m2/comp/desig.c
lang/m2/comp/enter.c
lang/m2/comp/lookup.c
lang/m2/comp/scope.C
lang/m2/comp/scope.h
lang/m2/comp/tmpvar.C
lang/m2/comp/type.H
lang/m2/comp/type.c
lang/m2/comp/typequiv.c
lang/m2/comp/walk.c

index e3e34ba..b8e92e8 100644 (file)
@@ -592,7 +592,7 @@ ChkProcCall(expp)
        */
        register t_node *left;
        t_def *edf = 0;
-       register struct paramlist *param;
+       register t_param *param;
        int retval = 1;
        int cnt = 0;
 
@@ -1264,12 +1264,12 @@ ChkCast(expp)
                is no problem as such values take a word on the EM stack
                anyway.
        */
-       register t_node *left = expp->nd_left;
        register t_node *arg = expp->nd_right;
-       register t_type *lefttype = left->nd_type;
+       register t_type *lefttype = expp->nd_left->nd_type;
+       t_def           *df = expp->nd_left->nd_def;
 
        if ((! arg) || arg->nd_right) {
-               return df_error(expp, "type cast must have 1 parameter", left->nd_def);
+               return df_error(expp, "type cast must have 1 parameter", df);
        }
 
        if (! ChkExpression(arg->nd_left)) return 0;
@@ -1280,11 +1280,17 @@ ChkCast(expp)
        if (arg->nd_type->tp_size != lefttype->tp_size &&
            (arg->nd_type->tp_size > word_size ||
             lefttype->tp_size > word_size)) {
-               df_error(expp, "unequal sizes in type cast", left->nd_def);
+               return df_error(expp, "unequal sizes in type cast", df);
+       }
+
+       if (IsConformantArray(arg->nd_type)) {
+               return df_error(expp,
+                 "type transfer function on conformant array not supported",
+                 df);
        }
 
        if (arg->nd_class == Value) {
-               FreeNode(left);
+               FreeNode(expp->nd_left);
                expp->nd_right->nd_left = 0;
                FreeNode(expp->nd_right);
                *expp = *arg;
index f70e4d9..f51ab47 100644 (file)
@@ -359,7 +359,7 @@ CodeCall(nd)
 }
 
 CodeParameters(param, arg)
-       struct paramlist *param;
+       t_param *param;
        t_node *arg;
 {
        register t_type *tp;
index 8d76e3c..bc9ac58 100644 (file)
 int            proclevel = 0;          /* nesting level of procedures */
 int            return_occurred;        /* set if a return occurs in a block */
 
+extern t_node  *EmptyStatement;
+
 #define needs_static_link()    (proclevel > 1)
-extern t_node *EmptyStatement;
 }
 
 /* inline in declaration: need space
-ProcedureDeclaration
-{
      t_def *df;
-} :
                      {       ++proclevel; }
      ProcedureHeading(&df, D_PROCEDURE)
      ';' block(&(df->prc_body))
      IDENT
                      {       EndProc(df, dot.TOK_IDF);
                              --proclevel;
                      }
-;
+ * ProcedureDeclaration
+ * {
*     t_def *df;
+ * } :
*                     {       ++proclevel; }
*     ProcedureHeading(&df, D_PROCEDURE)
*     ';' block(&(df->prc_body))
*     IDENT
*                     {       EndProc(df, dot.TOK_IDF);
*                             --proclevel;
*                     }
+ * ;
 */
 
 ProcedureHeading(t_def **pdf; int type;)
 {
-       t_type *tp = 0;
-       arith parmaddr = needs_static_link() ? pointer_size : 0;
-       struct paramlist *pr = 0;
+       t_type  *tp = 0;
+       arith   parmaddr = needs_static_link() ? pointer_size : 0;
+       t_param *pr = 0;
 } :
        PROCEDURE IDENT
                        { *pdf = DeclProc(type, dot.TOK_IDF); }
@@ -116,25 +117,25 @@ declaration
 ;
 
 /* inline in procedureheading: need space
-FormalParameters(struct paramlist **ppr; arith *parmaddr; t_type **ptp;):
      '('
      [
              FPSection(ppr, parmaddr)
              [
                      ';' FPSection(ppr, parmaddr)
              ]*
      ]?
      ')'
      [       ':' qualtype(ptp)
      ]?
-;
+ * FormalParameters(t_param **ppr; arith *parmaddr; t_type **ptp;):
*     '('
*     [
*             FPSection(ppr, parmaddr)
*             [
*                     ';' FPSection(ppr, parmaddr)
*             ]*
*     ]?
*     ')'
*     [       ':' qualtype(ptp)
*     ]?
+ * ;
 */
 
-FPSection(struct paramlist **ppr; arith *parmaddr;)
+FPSection(t_param **ppr; arith *parmaddr;)
 {
-       t_node *FPList;
-       t_type *tp;
-       int VARp;
+       t_node  *FPList;
+       t_type  *tp;
+       int     VARp;
 } :
        var(&VARp) IdentList(&FPList) ':' FormalType(&tp)
                        { EnterParamList(ppr, FPList, tp, VARp, parmaddr); }
@@ -267,7 +268,7 @@ ArrayType(t_type **ptp;)
 
 RecordType(t_type **ptp;)
 {
-       register struct scope *scope;
+       register t_scope *scope;
        arith size = 0;
        int xalign = struct_align;
 }
@@ -285,14 +286,14 @@ RecordType(t_type **ptp;)
        END
 ;
 
-FieldListSequence(struct scope *scope; arith *cnt; int *palign;):
+FieldListSequence(t_scope *scope; arith *cnt; int *palign;):
        FieldList(scope, cnt, palign)
        [
                ';' FieldList(scope, cnt, palign)
        ]*
 ;
 
-FieldList(struct scope *scope; arith *cnt; int *palign;)
+FieldList(t_scope *scope; arith *cnt; int *palign;)
 {
        t_node *FldList;
        t_type *tp;
@@ -358,7 +359,7 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
 ]?
 ;
 
-variant(struct scope *scope; arith *cnt; t_type *tp; int *palign;)
+variant(t_scope *scope; arith *cnt; t_type *tp; int *palign;)
 {
        t_node *nd;
 } :
@@ -442,7 +443,7 @@ ProcedureType(t_type **ptp;) :
                FormalTypeList(ptp)
        |
                        { *ptp = proc_type((t_type *) 0, 
-                                          (struct paramlist *) 0,
+                                          (t_param *) 0,
                                           (arith) 0);
                        }
        ]
@@ -450,7 +451,7 @@ ProcedureType(t_type **ptp;) :
 
 FormalTypeList(t_type **ptp;)
 {
-       struct paramlist *pr = 0;
+       t_param *pr = 0;
        arith parmaddr = 0;
 } :
        '('
@@ -467,7 +468,7 @@ FormalTypeList(t_type **ptp;)
                        { *ptp = proc_type(*ptp, pr, parmaddr); }
 ;
 
-VarFormalType(struct paramlist **ppr; arith *parmaddr;)
+VarFormalType(t_param **ppr; arith *parmaddr;)
 {
        t_type *tp;
        int isvar;
index b5d532c..516b6fd 100644 (file)
@@ -61,7 +61,7 @@ DefInFront(df)
 t_def *
 MkDef(id, scope, kind)
        register t_idf *id;
-       register struct scope *scope;
+       register t_scope *scope;
 {
        /*      Create a new definition structure in scope "scope", with
                id "id" and kind "kind".
@@ -85,7 +85,7 @@ MkDef(id, scope, kind)
 t_def *
 define(id, scope, kind)
        register t_idf *id;
-       register struct scope *scope;
+       register t_scope *scope;
        int kind;
 {
        /*      Declare an identifier in a scope, but first check if it
@@ -228,7 +228,7 @@ DeclProc(type, id)
                Also create a name for it.
        */
        register t_def *df;
-       register struct scope *scope;
+       register t_scope *scope;
        extern char *sprint();
        static int nmcount;
        char buf[256];
@@ -312,7 +312,7 @@ DefineLocalModule(id)
                a name to be used for code generation.
        */
        register t_def *df = define(id, CurrentScope, D_MODULE);
-       register struct scope *sc;
+       register t_scope *sc;
        static int modulecount = 0;
        char buf[256];
        extern char *sprint();
index 7e505f5..5df8e44 100644 (file)
@@ -91,10 +91,10 @@ GetDefinitionModule(id, incr)
        */
        register t_def *df;
        static int level;
-       struct scopelist *vis;
+       t_scopelist *vis;
        char *fn = FileName;
        int ln = LineNumber;
-       struct scope *newsc = CurrentScope;
+       t_scope *newsc = CurrentScope;
 
        level += incr;
        df = lookup(id, GlobalScope, 1);
index a908072..87d5e92 100644 (file)
@@ -473,7 +473,7 @@ CodeVarDesig(df, ds)
                it is a value parameter, it is a var parameter, it is one of
                those of an enclosing procedure, or it is global.
        */
-       register struct scope *sc = df->df_scope;
+       register t_scope *sc = df->df_scope;
 
        /* Selections from a module are handled earlier, when identifying
           the variable, so ...
index 0803a8c..b562873 100644 (file)
@@ -83,7 +83,7 @@ EnterEnumList(Idlist, type)
 EnterFieldList(Idlist, type, scope, addr)
        t_node *Idlist;
        register t_type *type;
-       struct scope *scope;
+       t_scope *scope;
        arith *addr;
 {
        /*      Put a list of fields in the symbol table.
@@ -115,7 +115,7 @@ EnterVarList(Idlist, type, local)
        */
        register t_def *df;
        register t_node *idlist = Idlist;
-       register struct scopelist *sc = CurrVis;
+       register t_scopelist *sc = CurrVis;
        char buf[256];
        extern char *sprint();
 
@@ -179,7 +179,7 @@ EnterVarList(Idlist, type, local)
 }
 
 EnterParamList(ppr, Idlist, type, VARp, off)
-       struct paramlist **ppr;
+       t_param **ppr;
        t_node *Idlist;
        t_type *type;
        int VARp;
@@ -189,11 +189,11 @@ EnterParamList(ppr, Idlist, type, VARp, off)
                "ids" indicates the list of identifiers, "tp" their type, and
                "VARp" indicates D_VARPAR or D_VALPAR.
        */
-       register struct paramlist *pr;
+       register t_param *pr;
        register t_def *df;
        register t_node *idlist = Idlist;
        t_node *dummy = 0;
-       static struct paramlist *last;
+       static t_param *last;
 
        if (! idlist) {
                /* Can only happen when a procedure type is defined */
@@ -232,7 +232,7 @@ EnterParamList(ppr, Idlist, type, VARp, off)
 STATIC
 DoImport(df, scope)
        register t_def *df;
-       struct scope *scope;
+       t_scope *scope;
 {
        /*      Definition "df" is imported to scope "scope".
                Handle the case that it is an enumeration type or a module.
@@ -266,7 +266,7 @@ DoImport(df, scope)
        }
 }
 
-STATIC struct scopelist *
+STATIC t_scopelist *
 ForwModule(df, nd)
        register t_def *df;
        t_node *nd;
@@ -275,7 +275,7 @@ ForwModule(df, nd)
                We could also end up here for not found DEFINITION MODULES.
                Create a declaration and a scope for this module.
        */
-       struct scopelist *vis;
+       t_scopelist *vis;
 
        if (df->df_scope != GlobalScope) {
                df->df_scope = enclosing(CurrVis)->sc_scope;
@@ -298,7 +298,7 @@ ForwModule(df, nd)
 STATIC t_def *
 ForwDef(ids, scope)
        register t_node *ids;
-       struct scope *scope;
+       t_scope *scope;
 {
        /*      Enter a forward definition of "ids" in scope "scope",
                if it is not already defined.
@@ -396,7 +396,7 @@ EnterFromImportList(Idlist, FromDef, FromId)
        /*      Import the list Idlist from the module indicated by Fromdef.
        */
        register t_node *idlist = Idlist;
-       register struct scopelist *vis;
+       register t_scopelist *vis;
        register t_def *df;
        char *module_name = FromDef->df_idf->id_text;
        int forwflag = 0;
@@ -462,7 +462,7 @@ EnterImportList(Idlist, local)
                This case is indicated by the value 0 of the "local" flag.
        */
        register t_node *idlist = Idlist;
-       struct scope *sc = enclosing(CurrVis)->sc_scope;
+       t_scope *sc = enclosing(CurrVis)->sc_scope;
        extern t_def *GetDefinitionModule();
        struct f_info f;
        
index 6604c64..1c589ec 100644 (file)
@@ -26,7 +26,7 @@
 t_def *
 lookup(id, scope, import)
        register t_idf *id;
-       struct scope *scope;
+       t_scope *scope;
 {
        /*      Look up a definition of an identifier in scope "scope".
                Make the "def" list self-organizing.
@@ -65,14 +65,14 @@ lookup(id, scope, import)
 t_def *
 lookfor(id, vis, give_error)
        register t_node *id;
-       struct scopelist *vis;
+       t_scopelist *vis;
 {
        /*      Look for an identifier in the visibility range started by "vis".
                If it is not defined create a dummy definition and,
                if "give_error" is set, give an error message.
        */
        register t_def *df;
-       register struct scopelist *sc = vis;
+       register t_scopelist *sc = vis;
 
        while (sc) {
                df = lookup(id->nd_IDF, sc->sc_scope, 1);
index 05ff093..4001f3b 100644 (file)
 #include       "def.h"
 #include       "node.h"
 
-struct scope *PervasiveScope;
-struct scopelist *CurrVis, *GlobalVis;
+t_scope *PervasiveScope;
+t_scopelist *CurrVis, *GlobalVis;
 extern int proclevel;
-static struct scopelist *PervVis;
+static t_scopelist *PervVis;
 extern char options[];
 
 /* STATICALLOCDEF "scope" 10 */
@@ -37,8 +37,8 @@ open_scope(scopetype)
 {
        /*      Open a scope that is either open (automatic imports) or closed.
        */
-       register struct scope *sc = new_scope();
-       register struct scopelist *ls = new_scopelist();
+       register t_scope *sc = new_scope();
+       register t_scopelist *ls = new_scopelist();
        
        assert(scopetype == OPENSCOPE || scopetype == CLOSEDSCOPE);
 
@@ -53,10 +53,10 @@ open_scope(scopetype)
        CurrVis = ls;
 }
 
-struct scope *
+t_scope *
 open_and_close_scope(scopetype)
 {
-       struct scope *sc;
+       t_scope *sc;
 
        open_scope(scopetype);
        sc = CurrentScope;
@@ -66,8 +66,8 @@ open_and_close_scope(scopetype)
 
 InitScope()
 {
-       register struct scope *sc = new_scope();
-       register struct scopelist *ls = new_scopelist();
+       register t_scope *sc = new_scope();
+       register t_scopelist *ls = new_scopelist();
 
        sc->sc_scopeclosed = 0;
        sc->sc_def = 0;
@@ -161,7 +161,7 @@ df->df_idf->id_text);
                                   Maybe the definitions are in the
                                   enclosing scope?
                                */
-                               register struct scopelist *ls =
+                               register t_scopelist *ls =
                                                nextvisible(CurrVis);
                                t_def *df1 = df->df_nextinscope;
        
@@ -213,7 +213,7 @@ close_scope(flag)
                either POINTER declarations, or EXPORTs, or forward references
                to MODULES
        */
-       register struct scope *sc = CurrentScope;
+       register t_scope *sc = CurrentScope;
 
        assert(sc != 0);
 
index 1ccda93..bad7941 100644 (file)
@@ -38,10 +38,13 @@ struct scopelist {
        struct scopelist *sc_encl;
 };
 
-extern struct scope
+typedef struct scope t_scope;
+typedef struct scopelist t_scopelist;
+
+extern t_scope
        *PervasiveScope;
 
-extern struct scopelist
+extern t_scopelist
        *CurrVis, *GlobalVis;
 
 #define CurrentScope   (CurrVis->sc_scope)
@@ -50,4 +53,4 @@ extern struct scopelist
 #define scopeclosed(x) ((x)->sc_scopeclosed)
 #define nextvisible(x) ((x)->sc_next)          /* use with scopelists */
 
-struct scope *open_and_close_scope();
+t_scope *open_and_close_scope();
index 88429a5..8bb65a0 100644 (file)
@@ -39,11 +39,11 @@ struct tmpvar {
 
 static struct tmpvar   *TmpInts,       /* for integer temporaries */
                        *TmpPtrs;       /* for pointer temporaries */
-static struct scope    *ProcScope;     /* scope of procedure in which the
+static t_scope *ProcScope;     /* scope of procedure in which the
                                           temporaries are allocated
                                        */
 
-TmpOpen(sc) struct scope *sc;
+TmpOpen(sc) t_scope *sc;
 {
        /*      Initialize for temporaries in scope "sc".
        */
@@ -54,7 +54,7 @@ arith
 TmpSpace(sz, al)
        arith sz;
 {
-       register struct scope *sc = ProcScope;
+       register t_scope *sc = ProcScope;
 
        sc->sc_off = - WA(align(sz - sc->sc_off, al));
        return sc->sc_off;
index fdbaf7b..a295187 100644 (file)
@@ -16,6 +16,8 @@ struct paramlist {            /* structure for parameterlist of a PROCEDURE */
 #define TypeOfParam(xpar)      ((xpar)->par_def->df_type)
 };
 
+typedef struct paramlist t_param;
+
 /* ALLOCDEF "paramlist" 20 */
 
 struct enume {
index b6cc0ac..6669266 100644 (file)
@@ -393,7 +393,7 @@ subr_type(lb, ub)
 t_type *
 proc_type(result_type, parameters, n_bytes_params)
        t_type *result_type;
-       struct paramlist *parameters;
+       t_param *parameters;
        arith n_bytes_params;
 {
        register t_type *tp = construct_type(T_PROCEDURE, result_type);
@@ -538,7 +538,7 @@ FreeType(tp)
                This procedure is only called for types, constructed with
                T_PROCEDURE.
        */
-       register struct paramlist *pr, *pr1;
+       register t_param *pr, *pr1;
 
        assert(tp->tp_fund == T_PROCEDURE);
 
@@ -713,7 +713,7 @@ DumpType(tp)
                break;
        case T_PROCEDURE:
                {
-               register struct paramlist *par = ParamList(tp);
+               register t_param *par = ParamList(tp);
 
                print("PROCEDURE");
                if (par) {
index a102895..ca77ccb 100644 (file)
@@ -72,7 +72,7 @@ TstProcEquiv(tp1, tp2)
                may also be used for the testing of assignment compatibility
                between procedure variables and procedures.
        */
-       register struct paramlist *p1, *p2;
+       register t_param *p1, *p2;
 
        /* First check if the result types are equivalent
        */
index ced9c3f..aaf5357 100644 (file)
@@ -110,8 +110,8 @@ WalkModule(module)
                Also generate code for its body.
                This code is collected in an initialization routine.
        */
-       register struct scope *sc;
-       struct scopelist *savevis = CurrVis;
+       register t_scope *sc;
+       t_scopelist *savevis = CurrVis;
 
        CurrVis = module->mod_vis;
        priority = module->mod_priority ? module->mod_priority->nd_INT : 0;
@@ -176,10 +176,10 @@ WalkProcedure(procedure)
        /*      Walk through the definition of a procedure and all its
                local definitions, checking and generating code.
        */
-       struct scopelist *savevis = CurrVis;
-       register struct scope *sc = procedure->prc_vis->sc_scope;
+       t_scopelist *savevis = CurrVis;
+       register t_scope *sc = procedure->prc_vis->sc_scope;
        register t_type *tp;
-       register struct paramlist *param;
+       register t_param *param;
        label func_res_label = 0;
        arith StackAdjustment = 0;
        arith retsav = 0;
@@ -575,7 +575,7 @@ WalkStat(nd, exit_label)
 
        case WITH:
                {
-                       struct scopelist link;
+                       t_scopelist link;
                        struct withdesig wds;
                        t_desig ds;
 
@@ -728,7 +728,7 @@ DoForInit(nd)
        }
 
        if (df->df_scope != CurrentScope) {
-               register struct scopelist *sc = CurrVis;
+               register t_scopelist *sc = CurrVis;
 
                for (;;) {
                        if (!sc) {