# 2.11BSD#431 - /usr/src/ucb/PORT/pascal/src/fhdr.c

##### Functions

    fparams           X
    funchdr           X
    params            X

##### Variables

    bodycnts          X
    cntpatch          X
    nfppatch          X

       1: /*
       2:  * Copyright (c) 1980 Regents of the University of California.
       3:  * All rights reserved.  The Berkeley software License Agreement
       4:  * specifies the terms and conditions for redistribution.
       5:  */
       6:
       7: #ifndef lint
       8: static char sccsid[] = "@(#)fhdr.c	5.2 (Berkeley) 7/26/85";
       9: #endif not lint
      10:
      11: #include "whoami.h"
      12: #include "0.h"
      13: #include "tree.h"
      14: #include "opcode.h"
      15: #include "objfmt.h"
      16: #include "align.h"
      17: #include "tree_ty.h"
      18:
      19: /*
      20:  * this array keeps the pxp counters associated with
      21:  * functions and procedures, so that they can be output
      22:  * when their bodies are encountered
      23:  */
      24: int bodycnts[ DSPLYSZ ];
      25:
      26: #ifdef PC
      27: #   include "pc.h"
      28: #endif PC
      29:
      30: #ifdef OBJ
      31: int cntpatch;
      32: int nfppatch;
      33: #endif OBJ
      34:
      35: /*
      36:  * Funchdr inserts
      37:  * declaration of a the
      38:  * prog/proc/func into the
      39:  * namelist. It also handles
      40:  * the arguments and puts out
      41:  * a transfer which defines
      42:  * the entry point of a procedure.
      43:  */
      44:
      45: struct nl *
      46: funchdr(r)
      47:     struct tnode *r;
      48: {
      49:     register struct nl *p;
      50:     register struct tnode *rl;
      51:     struct nl *cp, *dp, *temp;
      52:     int o;
      53:
      54:     if (inpflist(r->p_dec.id_ptr)) {
      55:         opush('l');
      56:         yyretrieve();   /* kludge */
      57:     }
      58:     pfcnt++;
      59:     parts[ cbn ] |= RPRT;
      60:     line = r->p_dec.line_no;
      61:     if (r->p_dec.param_list == TR_NIL &&
      62:         (p=lookup1(r->p_dec.id_ptr)) != NIL && bn == cbn) {
      63:         /*
      64: 		 * Symbol already defined
      65: 		 * in this block. it is either
      66: 		 * a redeclared symbol (error)
      67: 		 * a forward declaration,
      68: 		 * or an external declaration.
      69: 		 * check that forwards are of the right kind:
      70: 		 *     if this fails, we are trying to redefine it
      71: 		 *     and enter() will complain.
      72: 		 */
      73:         if (  ( ( p->nl_flags & NFORWD ) != 0 )
      74:            && (  ( p->class == FUNC && r->tag == T_FDEC )
      75:               || ( p->class == PROC && r->tag == T_PDEC ) ) ) {
      76:             /*
      77: 			 * Grammar doesnt forbid
      78: 			 * types on a resolution
      79: 			 * of a forward function
      80: 			 * declaration.
      81: 			 */
      82:             if (p->class == FUNC && r->p_dec.type)
      83:                 error("Function type should be given only in forward declaration");
      84:             /*
      85: 			 * get another counter for the actual
      86: 			 */
      87:             if ( monflg ) {
      88:                 bodycnts[ cbn ] = getcnt();
      89:             }
      90: #			ifdef PC
      91:                 enclosing[ cbn ] = p -> symbol;
      92: #			endif PC
      93: #			ifdef PTREE
      94:                 /*
      95: 				 *	mark this proc/func as forward
      96: 				 *	in the pTree.
      97: 				 */
      98:                 pDEF( p -> inTree ).PorFForward = TRUE;
      99: #			endif PTREE
     100:             return (p);
     101:         }
     102:     }
     103:
     104:     /* if a routine segment is being compiled,
     105: 	 * do level one processing.
     106: 	 */
     107:
     108:      if ((r->tag != T_PROG) && (!progseen))
     109:         level1();
     110:
     111:
     112:     /*
     113: 	 * Declare the prog/proc/func
     114: 	 */
     115:     switch (r->tag) {
     116:         case T_PROG:
     117:             progseen = TRUE;
     118:             if (opt('z'))
     119:                 monflg = TRUE;
     120:             program = p = defnl(r->p_dec.id_ptr, PROG, NLNIL, 0);
     121:             p->value[3] = r->p_dec.line_no;
     122:             break;
     123:         case T_PDEC:
     124:             if (r->p_dec.type != TR_NIL)
     125:                 error("Procedures do not have types, only functions do");
     126:             p = enter(defnl(r->p_dec.id_ptr, PROC, NLNIL, 0));
     127:             p->nl_flags |= NMOD;
     128: #		    ifdef PC
     129:             enclosing[ cbn ] = r->p_dec.id_ptr;
     130:             p -> extra_flags |= NGLOBAL;
     131: #		    endif PC
     132:             break;
     133:         case T_FDEC:
     134:             {
     135:             register struct tnode *il;
     136:             il = r->p_dec.type;
     137:             if (il == TR_NIL) {
     138:                 temp = NLNIL;
     139:                 error("Function type must be specified");
     140:             } else if (il->tag != T_TYID) {
     141:                 temp = NLNIL;
     142:                 error("Function type can be specified only by using a type identifier");
     143:             } else
     144:                 temp = gtype(il);
     145:             }
     146:             p = enter(defnl(r->p_dec.id_ptr, FUNC, temp, NIL));
     147:             p->nl_flags |= NMOD;
     148:             /*
     149: 		     * An arbitrary restriction
     150: 		     */
     151:             switch (o = classify(p->type)) {
     152:                 case TFILE:
     153:                 case TARY:
     154:                 case TREC:
     155:                 case TSET:
     156:                 case TSTR:
     157:                     warning();
     158:                     if (opt('s')) {
     159:                         standard();
     160:                     }
     161:                     error("Functions should not return %ss", clnames[o]);
     162:             }
     163: #		    ifdef PC
     164:             enclosing[ cbn ] = r->p_dec.id_ptr;
     165:             p -> extra_flags |= NGLOBAL;
     166: #		    endif PC
     167:             break;
     168:         default:
     169:             panic("funchdr");
     170:     }
     171:     if (r->tag != T_PROG) {
     172:         /*
     173: 		 * Mark this proc/func as
     174: 		 * being forward declared
     175: 		 */
     176:         p->nl_flags |= NFORWD;
     177:         /*
     178: 		 * Enter the parameters
     179: 		 * in the next block for
     180: 		 * the time being
     181: 		 */
     182:         if (++cbn >= DSPLYSZ) {
     183:             error("Procedure/function nesting too deep");
     184:             pexit(ERRS);
     185:         }
     186:         /*
     187: 		 * For functions, the function variable
     188: 		 */
     189:         if (p->class == FUNC) {
     190: #			ifdef OBJ
     191:                 cp = defnl(r->p_dec.id_ptr, FVAR, p->type, 0);
     192: #			endif OBJ
     193: #			ifdef PC
     194:                 /*
     195: 				 * fvars used to be allocated and deallocated
     196: 				 * by the caller right before the arguments.
     197: 				 * the offset of the fvar was kept in
     198: 				 * value[NL_OFFS] of function (very wierd,
     199: 				 * but see asgnop).
     200: 				 * now, they are locals to the function
     201: 				 * with the offset kept in the fvar.
     202: 				 */
     203:
     204:                 cp = defnl(r->p_dec.id_ptr, FVAR, p->type,
     205:                 (int)-leven(roundup(
     206:                         (int)(DPOFF1+lwidth(p->type)),
     207:                     (long)align(p->type))));
     208:                 cp -> extra_flags |= NLOCAL;
     209: #			endif PC
     210:             cp->chain = p;
     211:             p->ptr[NL_FVAR] = cp;
     212:         }
     213:         /*
     214: 		 * Enter the parameters
     215: 		 * and compute total size
     216: 		 */
     217:             p->value[NL_OFFS] = params(p, r->p_dec.param_list);
     218:         /*
     219: 		 * because NL_LINENO field in the function
     220: 		 * namelist entry has been used (as have all
     221: 		 * the other fields), the line number is
     222: 		 * stored in the NL_LINENO field of its fvar.
     223: 		 */
     224:         if (p->class == FUNC)
     225:             p->ptr[NL_FVAR]->value[NL_LINENO] = r->p_dec.line_no;
     226:         else
     227:             p->value[NL_LINENO] = r->p_dec.line_no;
     228:         cbn--;
     229:     } else {
     230:         /*
     231: 		 * The wonderful
     232: 		 * program statement!
     233: 		 */
     234: #		ifdef OBJ
     235:             if (monflg) {
     236:                 (void) put(1, O_PXPBUF);
     237:                 cntpatch = put(2, O_CASE4, (long)0);
     238:                 nfppatch = put(2, O_CASE4, (long)0);
     239:             }
     240: #		endif OBJ
     241:         cp = p;
     242:         for (rl = r->p_dec.param_list; rl; rl = rl->list_node.next) {
     243:             if (rl->list_node.list == TR_NIL)
     244:                 continue;
     245:             dp = defnl((char *) rl->list_node.list, VAR, NLNIL, 0);
     246:             cp->chain = dp;
     247:             cp = dp;
     248:         }
     249:     }
     250:     /*
     251: 	 * Define a branch at
     252: 	 * the "entry point" of
     253: 	 * the prog/proc/func.
     254: 	 */
     255:     p->value[NL_ENTLOC] = (int) getlab();
     256:     if (monflg) {
     257:         bodycnts[ cbn ] = getcnt();
     258:         p->value[ NL_CNTR ] = 0;
     259:     }
     260: #	ifdef OBJ
     261:         (void) put(2, O_TRA4, (long)p->value[NL_ENTLOC]);
     262: #	endif OBJ
     263: #	ifdef PTREE
     264:         {
     265:         pPointer    PF = tCopy( r );
     266:
     267:         pSeize( PorFHeader[ nesting ] );
     268:         if ( r->tag != T_PROG ) {
     269:             pPointer    *PFs;
     270:
     271:             PFs = &( pDEF( PorFHeader[ nesting ] ).PorFPFs );
     272:             *PFs = ListAppend( *PFs , PF );
     273:         } else {
     274:             pDEF( PorFHeader[ nesting ] ).GlobProg = PF;
     275:         }
     276:         pRelease( PorFHeader[ nesting ] );
     277:         }
     278: #	endif PTREE
     279:     return (p);
     280: }
     281:
     282:     /*
     283: 	 * deal with the parameter declaration for a routine.
     284: 	 * p is the namelist entry of the routine.
     285: 	 * formalist is the parse tree for the parameter declaration.
     286: 	 * formalist	[0]	T_LISTPP
     287: 	 *		[1]	pointer to a formal
     288: 	 *		[2]	pointer to next formal
     289: 	 * for by-value or by-reference formals, the formal is
     290: 	 * formal	[0]	T_PVAL or T_PVAR
     291: 	 *		[1]	pointer to id_list
     292: 	 *		[2]	pointer to type (error if not typeid)
     293: 	 * for function and procedure formals, the formal is
     294: 	 * formal	[0]	T_PFUNC or T_PPROC
     295: 	 *		[1]	pointer to id_list (error if more than one)
     296: 	 *		[2]	pointer to type (error if not typeid, or proc)
     297: 	 *		[3]	pointer to formalist for this routine.
     298: 	 */
     299: fparams(p, formal)
     300:     register struct nl *p;
     301:     struct tnode *formal;       /* T_PFUNC or T_PPROC */
     302: {
     303:     (void) params(p, formal->pfunc_node.param_list);
     304:     p -> value[ NL_LINENO ] = formal->pfunc_node.line_no;
     305:     p -> ptr[ NL_FCHAIN ] = p -> chain;
     306:     p -> chain = NIL;
     307: }
     308:
     309: params(p, formalist)
     310:     register struct nl *p;
     311:     struct tnode *formalist;    /* T_LISTPP */
     312: {
     313:     struct nl *chainp, *savedp;
     314:     struct nl *dp;
     315:     register struct tnode *formalp; /* an element of the formal list */
     316:     register struct tnode *formal;  /* a formal */
     317:     struct tnode *r, *s, *t, *typ, *idlist;
     318:     int w, o;
     319:
     320:     /*
     321: 	 * Enter the parameters
     322: 	 * and compute total size
     323: 	 */
     324:     chainp = savedp = p;
     325:
     326: #	ifdef OBJ
     327:         o = 0;
     328: #	endif OBJ
     329: #	ifdef PC
     330:         /*
     331: 		 * parameters used to be allocated backwards,
     332: 		 * then fixed.  for pc, they are allocated correctly.
     333: 		 * also, they are aligned.
     334: 		 */
     335:         o = DPOFF2;
     336: #	endif PC
     337:     for (formalp = formalist; formalp != TR_NIL;
     338:             formalp = formalp->list_node.next) {
     339:         formal = formalp->list_node.list;
     340:         if (formal == TR_NIL)
     341:             continue;
     342:         /*
     343: 		 * Parametric procedures
     344: 		 * don't have types !?!
     345: 		 */
     346:         typ = formal->pfunc_node.type;
     347:         p = NLNIL;
     348:         if ( typ == TR_NIL ) {
     349:             if ( formal->tag != T_PPROC ) {
     350:             error("Types must be specified for arguments");
     351:             }
     352:         } else {
     353:             if ( formal->tag == T_PPROC ) {
     354:             error("Procedures cannot have types");
     355:             } else {
     356:             p = gtype(typ);
     357:             }
     358:         }
     359:         for (idlist = formal->param.id_list; idlist != TR_NIL;
     360:                 idlist = idlist->list_node.next) {
     361:             switch (formal->tag) {
     362:                 default:
     363:                     panic("funchdr2");
     364:                 case T_PVAL:
     365:                     if (p != NLNIL) {
     366:                         if (p->class == FILET)
     367:                             error("Files cannot be passed by value");
     368:                         else if (p->nl_flags & NFILES)
     369:                             error("Files cannot be a component of %ss passed by value",
     370:                                 nameof(p));
     371:                     }
     372: #				    ifdef OBJ
     373:                     w = lwidth(p);
     374:                     o -= even(w);
     375: #					ifdef DEC11
     376:                         dp = defnl((char *) idlist->list_node.list,
     377:                                 VAR, p, o);
     378: #					else
     379:                         dp = defnl((char *) idlist->list_node.list,
     380:                             VAR,p, (w < 2) ? o + 1 : o);
     381: #					endif DEC11
     382: #				    endif OBJ
     383: #				    ifdef PC
     384:                     o = roundup(o, (long) A_STACK);
     385:                     w = lwidth(p);
     386: #					ifndef DEC11
     387:                         if (w <= sizeof(int)) {
     388:                         o += sizeof(int) - w;
     389:                         }
     390: #					endif not DEC11
     391:                     dp = defnl((char *) idlist->list_node.list,VAR,
     392:                             p, o);
     393:                     o += w;
     394: #				    endif PC
     395:                     dp->nl_flags |= NMOD;
     396:                     break;
     397:                 case T_PVAR:
     398: #				    ifdef OBJ
     399:                     dp = defnl((char *) idlist->list_node.list, REF,
     400:                             p, o -= sizeof ( int * ) );
     401: #				    endif OBJ
     402: #				    ifdef PC
     403:                     dp = defnl( (char *) idlist->list_node.list, REF,
     404:                             p ,
     405:                         o = roundup( o , (long)A_STACK ) );
     406:                     o += sizeof(char *);
     407: #				    endif PC
     408:                     break;
     409:                 case T_PFUNC:
     410:                     if (idlist->list_node.next != TR_NIL) {
     411:                     error("Each function argument must be declared separately");
     412:                     idlist->list_node.next = TR_NIL;
     413:                     }
     414: #				    ifdef OBJ
     415:                     dp = defnl((char *) idlist->list_node.list,FFUNC,
     416:                         p, o -= sizeof ( int * ) );
     417: #				    endif OBJ
     418: #				    ifdef PC
     419:                     dp = defnl( (char *) idlist->list_node.list ,
     420:                         FFUNC , p ,
     421:                         o = roundup( o , (long)A_STACK ) );
     422:                     o += sizeof(char *);
     423: #				    endif PC
     424:                     dp -> nl_flags |= NMOD;
     425:                     fparams(dp, formal);
     426:                     break;
     427:                 case T_PPROC:
     428:                     if (idlist->list_node.next != TR_NIL) {
     429:                     error("Each procedure argument must be declared separately");
     430:                     idlist->list_node.next = TR_NIL;
     431:                     }
     432: #				    ifdef OBJ
     433:                     dp = defnl((char *) idlist->list_node.list,
     434:                         FPROC, p, o -= sizeof ( int * ) );
     435: #				    endif OBJ
     436: #				    ifdef PC
     437:                     dp = defnl( (char *) idlist->list_node.list ,
     438:                         FPROC , p,
     439:                         o = roundup( o , (long)A_STACK ) );
     440:                     o += sizeof(char *);
     441: #				    endif PC
     442:                     dp -> nl_flags |= NMOD;
     443:                     fparams(dp, formal);
     444:                     break;
     445:                 }
     446:             if (dp != NLNIL) {
     447: #				ifdef PC
     448:                     dp -> extra_flags |= NPARAM;
     449: #				endif PC
     450:                 chainp->chain = dp;
     451:                 chainp = dp;
     452:             }
     453:         }
     454:         if (typ != TR_NIL && typ->tag == T_TYCARY) {
     455: #		    ifdef OBJ
     456:             w = -even(lwidth(p->chain));
     457: #			ifndef DEC11
     458:                 w = (w > -2)? w + 1 : w;
     459: #			endif
     460: #		    endif OBJ
     461: #		    ifdef PC
     462:             w = lwidth(p->chain);
     463:             o = roundup(o, (long)A_STACK);
     464: #		    endif PC
     465:             /*
     466: 		     * Allocate space for upper and
     467: 		     * lower bounds and width.
     468: 		     */
     469:             for (s=typ; s->tag == T_TYCARY; s = s->ary_ty.type) {
     470:             for (r=s->ary_ty.type_list; r != TR_NIL;
     471:                         r = r->list_node.next) {
     472:                 t = r->list_node.list;
     473:                 p = p->chain;
     474: #			    ifdef OBJ
     475:                 o += w;
     476: #			    endif OBJ
     477:                 chainp->chain = defnl(t->crang_ty.lwb_var,
     478:                                 VAR, p, o);
     479:                 chainp = chainp->chain;
     480:                 chainp->nl_flags |= (NMOD | NUSED);
     481:                 p->nptr[0] = chainp;
     482:                 o += w;
     483:                 chainp->chain = defnl(t->crang_ty.upb_var,
     484:                                 VAR, p, o);
     485:                 chainp = chainp->chain;
     486:                 chainp->nl_flags |= (NMOD | NUSED);
     487:                 p->nptr[1] = chainp;
     488:                 o += w;
     489:                 chainp->chain  = defnl(0, VAR, p, o);
     490:                 chainp = chainp->chain;
     491:                 chainp->nl_flags |= (NMOD | NUSED);
     492:                 p->nptr[2] = chainp;
     493: #			    ifdef PC
     494:                 o += w;
     495: #			    endif PC
     496:             }
     497:             }
     498:         }
     499:     }
     500:     p = savedp;
     501: #	ifdef OBJ
     502:         /*
     503: 		 * Correct the naivete (naivety)
     504: 		 * of our above code to
     505: 		 * calculate offsets
     506: 		 */
     507:         for (dp = p->chain; dp != NLNIL; dp = dp->chain)
     508:             dp->value[NL_OFFS] += -o + DPOFF2;
     509:         return (-o + DPOFF2);
     510: #	endif OBJ
     511: #	ifdef PC
     512:         return roundup( o , (long)A_STACK );
     513: #	endif PC
     514: }

#### Defined functions

fparams defined in line 299; used 2 times

- in line 425, 443

funchdr defined in line 45; used 5 times

- in /usr/src/ucb/PORT/pascal/src/0.h line 749
- in /usr/src/ucb/PORT/pascal/src/pas.y line 139-142(2), 151, 303

params defined in line 309; used 2 times

- in line 217, 303

#### Defined variables

bodycnts defined in line 24; used 2 times

- in line 88, 257

cntpatch defined in line 31; used 1 times

- in line 237

nfppatch defined in line 32; used 1 times

- in line 238

sccsid defined in line 8; never used

Last modified: 1985-07-27 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 1467 |