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.3 (Berkeley) 11/12/86"; 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)-roundup(roundup( 206 (int)(DPOFF1+lwidth(p->type)), 207 (long)align(p->type))), (long) A_STACK); 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 -= roundup(w, (long) A_STACK); 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 = -roundup(lwidth(p->chain), (long) A_STACK); 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 } 515