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