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
funchdr defined in line 45; used 5 times
params defined in line 309; used 2 times

Defined variables

bodycnts defined in line 24; used 2 times
cntpatch defined in line 31; used 1 times
nfppatch defined in line 32; used 1 times
sccsid defined in line 8; never used
Last modified: 1985-07-27
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 3401
Valid CSS Valid XHTML 1.0 Strict