BSD 4_3 release

[unix-history] / usr / src / ucb / pascal / src / fhdr.c

diff --git a/usr/src/ucb/pascal/src/fhdr.c b/usr/src/ucb/pascal/src/fhdr.c
index 3c1f8ad..61f5220 100644 (file)
--- a/usr/src/ucb/pascal/src/fhdr.c
+++ b/usr/src/ucb/pascal/src/fhdr.c
@@ -1,6 +1,12 @@
-/* Copyright (c) 1979 Regents of the University of California */
+/*
+ * Copyright (c) 1980 Regents of the University of California.
+ * All rights reserved.  The Berkeley software License Agreement
+ * specifies the terms and conditions for redistribution.
+ */

 
 

-static char sccsid[] = "@(#)fhdr.c 1.6 2/1/83";
+#ifndef lint
+static char sccsid[] = "@(#)fhdr.c     5.2 (Berkeley) 7/26/85";
+#endif not lint

 
 #include "whoami.h"
 #include "0.h"
 
 #include "whoami.h"
 #include "0.h"


@@ -8,6 +14,7 @@ static char sccsid[] = "@(#)fhdr.c 1.6 2/1/83";
 #include "opcode.h"
 #include "objfmt.h"
 #include "align.h"
 #include "opcode.h"
 #include "objfmt.h"
 #include "align.h"

+#include "tree_ty.h"

 
 /*
  * this array keeps the pxp counters associated with
 
 /*
  * this array keeps the pxp counters associated with


@@ -18,7 +25,6 @@ int   bodycnts[ DSPLYSZ ];
 
 #ifdef PC
 #   include "pc.h"
 
 #ifdef PC
 #   include "pc.h"

-#   include "pcops.h"

 #endif PC
 
 #ifdef OBJ
 #endif PC
 
 #ifdef OBJ


@@ -38,21 +44,22 @@ int nfppatch;
 
 struct nl *
 funchdr(r)
 
 struct nl *
 funchdr(r)

-       int *r;
+       struct tnode *r;

 {
        register struct nl *p;
 {
        register struct nl *p;

-       register *il, **rl;
-       struct nl *cp, *dp;
-       int s, o, *pp;
+       register struct tnode *rl;
+       struct nl *cp, *dp, *temp;
+       int o;

 
 

-       if (inpflist(r[2])) {
+       if (inpflist(r->p_dec.id_ptr)) {

                opush('l');
                yyretrieve();   /* kludge */
        }
        pfcnt++;
        parts[ cbn ] |= RPRT;
                opush('l');
                yyretrieve();   /* kludge */
        }
        pfcnt++;
        parts[ cbn ] |= RPRT;

-       line = r[1];
-       if (r[3] == NIL && (p=lookup1(r[2])) != NIL && bn == cbn) {
+       line = r->p_dec.line_no;
+       if (r->p_dec.param_list == TR_NIL &&
+               (p=lookup1(r->p_dec.id_ptr)) != NIL && bn == cbn) {

                /*
                 * Symbol already defined
                 * in this block. it is either
                /*
                 * Symbol already defined
                 * in this block. it is either


@@ -64,15 +71,15 @@ funchdr(r)
                 *     and enter() will complain.
                 */
                if (  ( ( p->nl_flags & NFORWD ) != 0 )
                 *     and enter() will complain.
                 */
                if (  ( ( p->nl_flags & NFORWD ) != 0 )

-                  && (  ( p->class == FUNC && r[0] == T_FDEC )
-                     || ( p->class == PROC && r[0] == T_PDEC ) ) ) {
+                  && (  ( p->class == FUNC && r->tag == T_FDEC )
+                     || ( p->class == PROC && r->tag == T_PDEC ) ) ) {

                        /*
                         * Grammar doesnt forbid
                         * types on a resolution
                         * of a forward function
                         * declaration.
                         */
                        /*
                         * Grammar doesnt forbid
                         * types on a resolution
                         * of a forward function
                         * declaration.
                         */

-                       if (p->class == FUNC && r[4])
+                       if (p->class == FUNC && r->p_dec.type)

                                error("Function type should be given only in forward declaration");
                        /*
                         * get another counter for the actual
                                error("Function type should be given only in forward declaration");
                        /*
                         * get another counter for the actual


@@ -98,41 +105,45 @@ funchdr(r)
         * do level one processing.
         */
 
         * do level one processing.
         */
 

-        if ((r[0] != T_PROG) && (!progseen))
+        if ((r->tag != T_PROG) && (!progseen))

                level1();
 
 
        /*
         * Declare the prog/proc/func
         */
                level1();
 
 
        /*
         * Declare the prog/proc/func
         */

-       switch (r[0]) {
+       switch (r->tag) {

            case T_PROG:
                    progseen = TRUE;
                    if (opt('z'))
                            monflg = TRUE;
            case T_PROG:
                    progseen = TRUE;
                    if (opt('z'))
                            monflg = TRUE;

-                   program = p = defnl(r[2], PROG, 0, 0);
-                   p->value[3] = r[1];
+                   program = p = defnl(r->p_dec.id_ptr, PROG, NLNIL, 0);
+                   p->value[3] = r->p_dec.line_no;

                    break;
            case T_PDEC:
                    break;
            case T_PDEC:

-                   if (r[4] != NIL)
+                   if (r->p_dec.type != TR_NIL)

                            error("Procedures do not have types, only functions do");
                            error("Procedures do not have types, only functions do");

-                   p = enter(defnl(r[2], PROC, 0, 0));
+                   p = enter(defnl(r->p_dec.id_ptr, PROC, NLNIL, 0));

                    p->nl_flags |= NMOD;
 #                  ifdef PC
                    p->nl_flags |= NMOD;
 #                  ifdef PC

-                       enclosing[ cbn ] = r[2];
+                       enclosing[ cbn ] = r->p_dec.id_ptr;

                        p -> extra_flags |= NGLOBAL;
 #                  endif PC
                    break;
            case T_FDEC:
                        p -> extra_flags |= NGLOBAL;
 #                  endif PC
                    break;
            case T_FDEC:

-                   il = r[4];
-                   if (il == NIL)
+                   {
+                       register struct tnode *il;
+                   il = r->p_dec.type;
+                   if (il == TR_NIL) {
+                           temp = NLNIL;

                            error("Function type must be specified");
                            error("Function type must be specified");

-                   else if (il[0] != T_TYID) {
-                           il = NIL;
+                   } else if (il->tag != T_TYID) {
+                           temp = NLNIL;

                            error("Function type can be specified only by using a type identifier");
                    } else
                            error("Function type can be specified only by using a type identifier");
                    } else

-                           il = gtype(il);
-                   p = enter(defnl(r[2], FUNC, il, NIL));
+                           temp = gtype(il);
+                   }
+                   p = enter(defnl(r->p_dec.id_ptr, FUNC, temp, NIL));

                    p->nl_flags |= NMOD;
                    /*
                     * An arbitrary restriction
                    p->nl_flags |= NMOD;
                    /*
                     * An arbitrary restriction


@@ -150,14 +161,14 @@ funchdr(r)
                                    error("Functions should not return %ss", clnames[o]);
                    }
 #                  ifdef PC
                                    error("Functions should not return %ss", clnames[o]);
                    }
 #                  ifdef PC

-                       enclosing[ cbn ] = r[2];
+                       enclosing[ cbn ] = r->p_dec.id_ptr;

                        p -> extra_flags |= NGLOBAL;
 #                  endif PC
                    break;
            default:
                    panic("funchdr");
        }
                        p -> extra_flags |= NGLOBAL;
 #                  endif PC
                    break;
            default:
                    panic("funchdr");
        }

-       if (r[0] != T_PROG) {
+       if (r->tag != T_PROG) {

                /*
                 * Mark this proc/func as
                 * being forward declared
                /*
                 * Mark this proc/func as
                 * being forward declared


@@ -177,7 +188,7 @@ funchdr(r)
                 */
                if (p->class == FUNC) {
 #                      ifdef OBJ
                 */
                if (p->class == FUNC) {
 #                      ifdef OBJ

-                           cp = defnl(r[2], FVAR, p->type, 0);
+                           cp = defnl(r->p_dec.id_ptr, FVAR, p->type, 0);

 #                      endif OBJ
 #                      ifdef PC
                                /*
 #                      endif OBJ
 #                      ifdef PC
                                /*


@@ -190,7 +201,7 @@ funchdr(r)
                                 * with the offset kept in the fvar.
                                 */
 
                                 * with the offset kept in the fvar.
                                 */
 

-                           cp = defnl(r[2], FVAR, p->type,
+                           cp = defnl(r->p_dec.id_ptr, FVAR, p->type,

                                (int)-leven(roundup(
                                    (int)(DPOFF1+lwidth(p->type)),
                                    (long)align(p->type))));
                                (int)-leven(roundup(
                                    (int)(DPOFF1+lwidth(p->type)),
                                    (long)align(p->type))));


@@ -203,7 +214,7 @@ funchdr(r)
                 * Enter the parameters
                 * and compute total size
                 */
                 * Enter the parameters
                 * and compute total size
                 */

-               p->value[NL_OFFS] = params(p, r[3]);
+               p->value[NL_OFFS] = params(p, r->p_dec.param_list);

                /*
                 * because NL_LINENO field in the function 
                 * namelist entry has been used (as have all
                /*
                 * because NL_LINENO field in the function 
                 * namelist entry has been used (as have all


@@ -211,9 +222,9 @@ funchdr(r)
                 * stored in the NL_LINENO field of its fvar.
                 */
                if (p->class == FUNC)
                 * stored in the NL_LINENO field of its fvar.
                 */
                if (p->class == FUNC)

-                   p->ptr[NL_FVAR]->value[NL_LINENO] = r[1];
+                   p->ptr[NL_FVAR]->value[NL_LINENO] = r->p_dec.line_no;

                else
                else

-                   p->value[NL_LINENO] = r[1];
+                   p->value[NL_LINENO] = r->p_dec.line_no;

                cbn--;
        } else { 
                /*
                cbn--;
        } else { 
                /*


@@ -222,16 +233,16 @@ funchdr(r)
                 */
 #              ifdef OBJ
                    if (monflg) {
                 */
 #              ifdef OBJ
                    if (monflg) {

-                           put(1, O_PXPBUF);
+                           (void) put(1, O_PXPBUF);

                            cntpatch = put(2, O_CASE4, (long)0);
                            nfppatch = put(2, O_CASE4, (long)0);
                    }
 #              endif OBJ
                cp = p;
                            cntpatch = put(2, O_CASE4, (long)0);
                            nfppatch = put(2, O_CASE4, (long)0);
                    }
 #              endif OBJ
                cp = p;

-               for (rl = r[3]; rl; rl = rl[2]) {
-                       if (rl[1] == NIL)
+               for (rl = r->p_dec.param_list; rl; rl = rl->list_node.next) {
+                       if (rl->list_node.list == TR_NIL)

                                continue;
                                continue;

-                       dp = defnl(rl[1], VAR, 0, 0);
+                       dp = defnl((char *) rl->list_node.list, VAR, NLNIL, 0);

                        cp->chain = dp;
                        cp = dp;
                }
                        cp->chain = dp;
                        cp = dp;
                }


@@ -241,20 +252,20 @@ funchdr(r)
         * the "entry point" of
         * the prog/proc/func.
         */
         * the "entry point" of
         * the prog/proc/func.
         */

-       p->value[NL_ENTLOC] = getlab();
+       p->value[NL_ENTLOC] = (int) getlab();

        if (monflg) {
                bodycnts[ cbn ] = getcnt();
                p->value[ NL_CNTR ] = 0;
        }
 #      ifdef OBJ
        if (monflg) {
                bodycnts[ cbn ] = getcnt();
                p->value[ NL_CNTR ] = 0;
        }
 #      ifdef OBJ

-           put(2, O_TRA4, (long)p->value[NL_ENTLOC]);
+           (void) put(2, O_TRA4, (long)p->value[NL_ENTLOC]);

 #      endif OBJ
 #      ifdef PTREE
            {
                pPointer        PF = tCopy( r );
 
                pSeize( PorFHeader[ nesting ] );
 #      endif OBJ
 #      ifdef PTREE
            {
                pPointer        PF = tCopy( r );
 
                pSeize( PorFHeader[ nesting ] );

-               if ( r[0] != T_PROG ) {
+               if ( r->tag != T_PROG ) {

                        pPointer        *PFs;
 
                        PFs = &( pDEF( PorFHeader[ nesting ] ).PorFPFs );
                        pPointer        *PFs;
 
                        PFs = &( pDEF( PorFHeader[ nesting ] ).PorFPFs );


@@ -287,23 +298,23 @@ funchdr(r)
         */
 fparams(p, formal)
        register struct nl *p;
         */
 fparams(p, formal)
        register struct nl *p;

-       int *formal;
+       struct tnode *formal;           /* T_PFUNC or T_PPROC */

 {
 {

-       params(p, formal[3]);
-       p -> value[ NL_LINENO ] = formal[4];
+       (void) params(p, formal->pfunc_node.param_list);
+       p -> value[ NL_LINENO ] = formal->pfunc_node.line_no;

        p -> ptr[ NL_FCHAIN ] = p -> chain;
        p -> chain = NIL;
 }
 
 params(p, formalist)
        register struct nl *p;
        p -> ptr[ NL_FCHAIN ] = p -> chain;
        p -> chain = NIL;
 }
 
 params(p, formalist)
        register struct nl *p;

-       int *formalist;
+       struct tnode *formalist;        /* T_LISTPP */

 {
        struct nl *chainp, *savedp;
        struct nl *dp;
 {
        struct nl *chainp, *savedp;
        struct nl *dp;

-       register int **formalp;         /* an element of the formal list */
-       register int *formal;           /* a formal */
-       int *typ, *idlist;
+       register struct tnode *formalp; /* an element of the formal list */
+       register struct tnode *formal;  /* a formal */
+       struct tnode *r, *s, *t, *typ, *idlist;

        int w, o;
 
        /*
        int w, o;
 
        /*


@@ -323,40 +334,35 @@ params(p, formalist)
                 */
            o = DPOFF2;
 #      endif PC
                 */
            o = DPOFF2;
 #      endif PC

-       for (formalp = formalist; formalp != NIL; formalp = formalp[2]) {
-               p = NIL;
-               formal = formalp[1];
-               if (formal == NIL)
+       for (formalp = formalist; formalp != TR_NIL;
+                       formalp = formalp->list_node.next) {
+               formal = formalp->list_node.list;
+               if (formal == TR_NIL)

                        continue;
                /*
                 * Parametric procedures
                 * don't have types !?!
                 */
                        continue;
                /*
                 * Parametric procedures
                 * don't have types !?!
                 */

-               typ = formal[2];
-               if ( typ == NIL ) {
-                   if ( formal[0] != T_PPROC ) {
+               typ = formal->pfunc_node.type;
+               p = NLNIL;
+               if ( typ == TR_NIL ) {
+                   if ( formal->tag != T_PPROC ) {

                        error("Types must be specified for arguments");
                        error("Types must be specified for arguments");

-                       p = NIL;

                    }
                } else {
                    }
                } else {

-                   if ( formal[0] == T_PPROC ) {
+                   if ( formal->tag == T_PPROC ) {

                        error("Procedures cannot have types");
                        error("Procedures cannot have types");

-                       p = NIL;

                    } else {
                    } else {

-                       if (typ[0] != T_TYID) {
-                               error("Types for arguments can be specified only by using type identifiers");
-                               p = NIL;
-                       } else {
-                               p = gtype(typ);
-                       }
+                       p = gtype(typ);

                    }
                }
                    }
                }

-               for (idlist = formal[1]; idlist != NIL; idlist = idlist[2]) {
-                       switch (formal[0]) {
+               for (idlist = formal->param.id_list; idlist != TR_NIL;
+                               idlist = idlist->list_node.next) {
+                       switch (formal->tag) {

                            default:
                                    panic("funchdr2");
                            case T_PVAL:
                            default:
                                    panic("funchdr2");
                            case T_PVAL:

-                                   if (p != NIL) {
+                                   if (p != NLNIL) {

                                            if (p->class == FILET)
                                                    error("Files cannot be passed by value");
                                            else if (p->nl_flags & NFILES)
                                            if (p->class == FILET)
                                                    error("Files cannot be passed by value");
                                            else if (p->nl_flags & NFILES)


@@ -367,69 +373,77 @@ params(p, formalist)
                                        w = lwidth(p);
                                        o -= even(w);
 #                                      ifdef DEC11
                                        w = lwidth(p);
                                        o -= even(w);
 #                                      ifdef DEC11

-                                           dp = defnl(idlist[1], VAR, p, o);
+                                           dp = defnl((char *) idlist->list_node.list,
+                                                               VAR, p, o);

 #                                      else
 #                                      else

-                                           dp = defnl(idlist[1], VAR, p,
-                                               (w < 2) ? o + 1 : o);
+                                           dp = defnl((char *) idlist->list_node.list,
+                                                   VAR,p, (w < 2) ? o + 1 : o);

 #                                      endif DEC11
 #                                  endif OBJ
 #                                  ifdef PC
 #                                      endif DEC11
 #                                  endif OBJ
 #                                  ifdef PC

-                                       o = roundup(o, A_STACK);
+                                       o = roundup(o, (long) A_STACK);

                                        w = lwidth(p);
 #                                      ifndef DEC11
                                            if (w <= sizeof(int)) {
                                                o += sizeof(int) - w;
                                            }
 #                                      endif not DEC11
                                        w = lwidth(p);
 #                                      ifndef DEC11
                                            if (w <= sizeof(int)) {
                                                o += sizeof(int) - w;
                                            }
 #                                      endif not DEC11

-                                       dp = defnl(idlist[1], VAR, p, o);
+                                       dp = defnl((char *) idlist->list_node.list,VAR,
+                                                       p, o);

                                        o += w;
 #                                  endif PC
                                    dp->nl_flags |= NMOD;
                                    break;
                            case T_PVAR:
 #                                  ifdef OBJ
                                        o += w;
 #                                  endif PC
                                    dp->nl_flags |= NMOD;
                                    break;
                            case T_PVAR:
 #                                  ifdef OBJ

-                                       dp = defnl(idlist[1], REF, p, o -= sizeof ( int * ) );
+                                       dp = defnl((char *) idlist->list_node.list, REF,
+                                                   p, o -= sizeof ( int * ) );

 #                                  endif OBJ
 #                                  ifdef PC
 #                                  endif OBJ
 #                                  ifdef PC

-                                       dp = defnl( idlist[1] , REF , p
-                                               , o = roundup( o , (long)A_STACK ) );
+                                       dp = defnl( (char *) idlist->list_node.list, REF,
+                                                   p , 
+                                           o = roundup( o , (long)A_STACK ) );

                                        o += sizeof(char *);
 #                                  endif PC
                                    break;
                            case T_PFUNC:
                                        o += sizeof(char *);
 #                                  endif PC
                                    break;
                            case T_PFUNC:

-                                   if (idlist[2] != NIL) {
+                                   if (idlist->list_node.next != TR_NIL) {

                                        error("Each function argument must be declared separately");
                                        error("Each function argument must be declared separately");

-                                       idlist[2] = NIL;
+                                       idlist->list_node.next = TR_NIL;

                                    }
 #                                  ifdef OBJ
                                    }
 #                                  ifdef OBJ

-                                       dp = defnl(idlist[1], FFUNC, p, o -= sizeof ( int * ) );
+                                       dp = defnl((char *) idlist->list_node.list,FFUNC,
+                                               p, o -= sizeof ( int * ) );

 #                                  endif OBJ
 #                                  ifdef PC
 #                                  endif OBJ
 #                                  ifdef PC

-                                       dp = defnl( idlist[1] , FFUNC , p
-                                               , o = roundup( o , (long)A_STACK ) );
+                                       dp = defnl( (char *) idlist->list_node.list , 
+                                               FFUNC , p ,
+                                               o = roundup( o , (long)A_STACK ) );

                                        o += sizeof(char *);
 #                                  endif PC
                                    dp -> nl_flags |= NMOD;
                                    fparams(dp, formal);
                                    break;
                            case T_PPROC:
                                        o += sizeof(char *);
 #                                  endif PC
                                    dp -> nl_flags |= NMOD;
                                    fparams(dp, formal);
                                    break;
                            case T_PPROC:

-                                   if (idlist[2] != NIL) {
+                                   if (idlist->list_node.next != TR_NIL) {

                                        error("Each procedure argument must be declared separately");
                                        error("Each procedure argument must be declared separately");

-                                       idlist[2] = NIL;
+                                       idlist->list_node.next = TR_NIL;

                                    }
 #                                  ifdef OBJ
                                    }
 #                                  ifdef OBJ

-                                       dp = defnl(idlist[1], FPROC, p, o -= sizeof ( int * ) );
+                                       dp = defnl((char *) idlist->list_node.list,
+                                           FPROC, p, o -= sizeof ( int * ) );

 #                                  endif OBJ
 #                                  ifdef PC
 #                                  endif OBJ
 #                                  ifdef PC

-                                       dp = defnl( idlist[1] , FPROC , p
-                                               , o = roundup( o , (long)A_STACK ) );
+                                       dp = defnl( (char *) idlist->list_node.list ,
+                                               FPROC , p,
+                                               o = roundup( o , (long)A_STACK ) );

                                        o += sizeof(char *);
 #                                  endif PC
                                    dp -> nl_flags |= NMOD;
                                    fparams(dp, formal);
                                    break;
                            }
                                        o += sizeof(char *);
 #                                  endif PC
                                    dp -> nl_flags |= NMOD;
                                    fparams(dp, formal);
                                    break;
                            }

-                       if (dp != NIL) {
+                       if (dp != NLNIL) {

 #                              ifdef PC
                                    dp -> extra_flags |= NPARAM;
 #                              endif PC
 #                              ifdef PC
                                    dp -> extra_flags |= NPARAM;
 #                              endif PC


@@ -437,6 +451,51 @@ params(p, formalist)
                                chainp = dp;
                        }
                }
                                chainp = dp;
                        }
                }

+               if (typ != TR_NIL && typ->tag == T_TYCARY) {
+#                  ifdef OBJ
+                       w = -even(lwidth(p->chain));
+#                      ifndef DEC11
+                           w = (w > -2)? w + 1 : w;
+#                      endif
+#                  endif OBJ
+#                  ifdef PC
+                       w = lwidth(p->chain);
+                       o = roundup(o, (long)A_STACK);
+#                  endif PC
+                   /*
+                    * Allocate space for upper and
+                    * lower bounds and width.
+                    */
+                   for (s=typ; s->tag == T_TYCARY; s = s->ary_ty.type) {
+                       for (r=s->ary_ty.type_list; r != TR_NIL;
+                                               r = r->list_node.next) {
+                           t = r->list_node.list;
+                           p = p->chain;
+#                          ifdef OBJ
+                               o += w;
+#                          endif OBJ
+                           chainp->chain = defnl(t->crang_ty.lwb_var,
+                                                               VAR, p, o);
+                           chainp = chainp->chain;
+                           chainp->nl_flags |= (NMOD | NUSED);
+                           p->nptr[0] = chainp;
+                           o += w;
+                           chainp->chain = defnl(t->crang_ty.upb_var,
+                                                               VAR, p, o);
+                           chainp = chainp->chain;
+                           chainp->nl_flags |= (NMOD | NUSED);
+                           p->nptr[1] = chainp;
+                           o += w;
+                           chainp->chain  = defnl(0, VAR, p, o);
+                           chainp = chainp->chain;
+                           chainp->nl_flags |= (NMOD | NUSED);
+                           p->nptr[2] = chainp;
+#                          ifdef PC
+                               o += w;
+#                          endif PC
+                       }
+                   }
+               }

        }
        p = savedp;
 #      ifdef OBJ
        }
        p = savedp;
 #      ifdef OBJ


@@ -445,7 +504,7 @@ params(p, formalist)
                 * of our above code to
                 * calculate offsets
                 */
                 * of our above code to
                 * calculate offsets
                 */

-           for (dp = p->chain; dp != NIL; dp = dp->chain)
+           for (dp = p->chain; dp != NLNIL; dp = dp->chain)

                    dp->value[NL_OFFS] += -o + DPOFF2;
            return (-o + DPOFF2);
 #      endif OBJ
                    dp->value[NL_OFFS] += -o + DPOFF2;
            return (-o + DPOFF2);
 #      endif OBJ