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