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
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
Defined variables
|
Last modified: 1985-07-27
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 3343 |
|