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.1 (Berkeley) 06/05/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 p = NLNIL; 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 if ( typ == TR_NIL ) { 349 if ( formal->tag != T_PPROC ) { 350 error("Types must be specified for arguments"); 351 p = NLNIL; 352 } 353 } else { 354 if ( formal->tag == T_PPROC ) { 355 error("Procedures cannot have types"); 356 p = NLNIL; 357 } else { 358 p = gtype(typ); 359 } 360 } 361 for (idlist = formal->param.id_list; idlist != TR_NIL; 362 idlist = idlist->list_node.next) { 363 switch (formal->tag) { 364 default: 365 panic("funchdr2"); 366 case T_PVAL: 367 if (p != NLNIL) { 368 if (p->class == FILET) 369 error("Files cannot be passed by value"); 370 else if (p->nl_flags & NFILES) 371 error("Files cannot be a component of %ss passed by value", 372 nameof(p)); 373 } 374 # ifdef OBJ 375 w = lwidth(p); 376 o -= even(w); 377 # ifdef DEC11 378 dp = defnl((char *) idlist->list_node.list, 379 VAR, p, o); 380 # else 381 dp = defnl((char *) idlist->list_node.list, 382 VAR,p, (w < 2) ? o + 1 : o); 383 # endif DEC11 384 # endif OBJ 385 # ifdef PC 386 o = roundup(o, (long) A_STACK); 387 w = lwidth(p); 388 # ifndef DEC11 389 if (w <= sizeof(int)) { 390 o += sizeof(int) - w; 391 } 392 # endif not DEC11 393 dp = defnl((char *) idlist->list_node.list,VAR, 394 p, o); 395 o += w; 396 # endif PC 397 dp->nl_flags |= NMOD; 398 break; 399 case T_PVAR: 400 # ifdef OBJ 401 dp = defnl((char *) idlist->list_node.list, REF, 402 p, o -= sizeof ( int * ) ); 403 # endif OBJ 404 # ifdef PC 405 dp = defnl( (char *) idlist->list_node.list, REF, 406 p , 407 o = roundup( o , (long)A_STACK ) ); 408 o += sizeof(char *); 409 # endif PC 410 break; 411 case T_PFUNC: 412 if (idlist->list_node.next != TR_NIL) { 413 error("Each function argument must be declared separately"); 414 idlist->list_node.next = TR_NIL; 415 } 416 # ifdef OBJ 417 dp = defnl((char *) idlist->list_node.list,FFUNC, 418 p, o -= sizeof ( int * ) ); 419 # endif OBJ 420 # ifdef PC 421 dp = defnl( (char *) idlist->list_node.list , 422 FFUNC , p , 423 o = roundup( o , (long)A_STACK ) ); 424 o += sizeof(char *); 425 # endif PC 426 dp -> nl_flags |= NMOD; 427 fparams(dp, formal); 428 break; 429 case T_PPROC: 430 if (idlist->list_node.next != TR_NIL) { 431 error("Each procedure argument must be declared separately"); 432 idlist->list_node.next = TR_NIL; 433 } 434 # ifdef OBJ 435 dp = defnl((char *) idlist->list_node.list, 436 FPROC, p, o -= sizeof ( int * ) ); 437 # endif OBJ 438 # ifdef PC 439 dp = defnl( (char *) idlist->list_node.list , 440 FPROC , p, 441 o = roundup( o , (long)A_STACK ) ); 442 o += sizeof(char *); 443 # endif PC 444 dp -> nl_flags |= NMOD; 445 fparams(dp, formal); 446 break; 447 } 448 if (dp != NLNIL) { 449 # ifdef PC 450 dp -> extra_flags |= NPARAM; 451 # endif PC 452 chainp->chain = dp; 453 chainp = dp; 454 } 455 } 456 if (typ->tag == T_TYCARY) { 457 # ifdef OBJ 458 w = -even(lwidth(p->chain)); 459 # ifndef DEC11 460 w = (w > -2)? w + 1 : w; 461 # endif 462 # endif OBJ 463 # ifdef PC 464 w = lwidth(p->chain); 465 o = roundup(o, (long)A_STACK); 466 # endif PC 467 /* 468 * Allocate space for upper and 469 * lower bounds and width. 470 */ 471 for (s=typ; s->tag == T_TYCARY; s = s->ary_ty.type) { 472 for (r=s->ary_ty.type_list; r != TR_NIL; 473 r = r->list_node.next) { 474 t = r->list_node.list; 475 p = p->chain; 476 # ifdef OBJ 477 o += w; 478 # endif OBJ 479 chainp->chain = defnl(t->crang_ty.lwb_var, 480 VAR, p, o); 481 chainp = chainp->chain; 482 chainp->nl_flags |= (NMOD | NUSED); 483 p->nptr[0] = chainp; 484 o += w; 485 chainp->chain = defnl(t->crang_ty.upb_var, 486 VAR, p, o); 487 chainp = chainp->chain; 488 chainp->nl_flags |= (NMOD | NUSED); 489 p->nptr[1] = chainp; 490 o += w; 491 chainp->chain = defnl(0, VAR, p, o); 492 chainp = chainp->chain; 493 chainp->nl_flags |= (NMOD | NUSED); 494 p->nptr[2] = chainp; 495 # ifdef PC 496 o += w; 497 # endif PC 498 } 499 } 500 } 501 } 502 p = savedp; 503 # ifdef OBJ 504 /* 505 * Correct the naivete (naivety) 506 * of our above code to 507 * calculate offsets 508 */ 509 for (dp = p->chain; dp != NLNIL; dp = dp->chain) 510 dp->value[NL_OFFS] += -o + DPOFF2; 511 return (-o + DPOFF2); 512 # endif OBJ 513 # ifdef PC 514 return roundup( o , (long)A_STACK ); 515 # endif PC 516 } 517