1 /* Copyright (c) 1979 Regents of the University of California */ 2 3 #ifndef lint 4 static char sccsid[] = "@(#)fhdr.c 1.8 09/19/83"; 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 error("Function type must be specified"); 136 else if (il->tag != T_TYID) { 137 temp = NLNIL; 138 error("Function type can be specified only by using a type identifier"); 139 } else 140 temp = gtype(il); 141 } 142 { 143 register struct nl *il; 144 145 il = temp; 146 p = enter(defnl(r->p_dec.id_ptr, FUNC, il, NIL)); 147 148 } 149 150 p->nl_flags |= NMOD; 151 /* 152 * An arbitrary restriction 153 */ 154 switch (o = classify(p->type)) { 155 case TFILE: 156 case TARY: 157 case TREC: 158 case TSET: 159 case TSTR: 160 warning(); 161 if (opt('s')) { 162 standard(); 163 } 164 error("Functions should not return %ss", clnames[o]); 165 } 166 # ifdef PC 167 enclosing[ cbn ] = r->p_dec.id_ptr; 168 p -> extra_flags |= NGLOBAL; 169 # endif PC 170 break; 171 default: 172 panic("funchdr"); 173 } 174 if (r->tag != T_PROG) { 175 /* 176 * Mark this proc/func as 177 * being forward declared 178 */ 179 p->nl_flags |= NFORWD; 180 /* 181 * Enter the parameters 182 * in the next block for 183 * the time being 184 */ 185 if (++cbn >= DSPLYSZ) { 186 error("Procedure/function nesting too deep"); 187 pexit(ERRS); 188 } 189 /* 190 * For functions, the function variable 191 */ 192 if (p->class == FUNC) { 193 # ifdef OBJ 194 cp = defnl(r->p_dec.id_ptr, FVAR, p->type, 0); 195 # endif OBJ 196 # ifdef PC 197 /* 198 * fvars used to be allocated and deallocated 199 * by the caller right before the arguments. 200 * the offset of the fvar was kept in 201 * value[NL_OFFS] of function (very wierd, 202 * but see asgnop). 203 * now, they are locals to the function 204 * with the offset kept in the fvar. 205 */ 206 207 cp = defnl(r->p_dec.id_ptr, FVAR, p->type, 208 (int)-leven(roundup( 209 (int)(DPOFF1+lwidth(p->type)), 210 (long)align(p->type)))); 211 cp -> extra_flags |= NLOCAL; 212 # endif PC 213 cp->chain = p; 214 p->ptr[NL_FVAR] = cp; 215 } 216 /* 217 * Enter the parameters 218 * and compute total size 219 */ 220 p->value[NL_OFFS] = params(p, r->p_dec.param_list); 221 /* 222 * because NL_LINENO field in the function 223 * namelist entry has been used (as have all 224 * the other fields), the line number is 225 * stored in the NL_LINENO field of its fvar. 226 */ 227 if (p->class == FUNC) 228 p->ptr[NL_FVAR]->value[NL_LINENO] = r->p_dec.line_no; 229 else 230 p->value[NL_LINENO] = r->p_dec.line_no; 231 cbn--; 232 } else { 233 /* 234 * The wonderful 235 * program statement! 236 */ 237 # ifdef OBJ 238 if (monflg) { 239 (void) put(1, O_PXPBUF); 240 cntpatch = put(2, O_CASE4, (long)0); 241 nfppatch = put(2, O_CASE4, (long)0); 242 } 243 # endif OBJ 244 cp = p; 245 for (rl = r->p_dec.param_list; rl; rl = rl->list_node.next) { 246 if (rl->list_node.list == TR_NIL) 247 continue; 248 dp = defnl((char *) rl->list_node.list, VAR, NLNIL, 0); 249 cp->chain = dp; 250 cp = dp; 251 } 252 } 253 /* 254 * Define a branch at 255 * the "entry point" of 256 * the prog/proc/func. 257 */ 258 p->value[NL_ENTLOC] = (int) getlab(); 259 if (monflg) { 260 bodycnts[ cbn ] = getcnt(); 261 p->value[ NL_CNTR ] = 0; 262 } 263 # ifdef OBJ 264 (void) put(2, O_TRA4, (long)p->value[NL_ENTLOC]); 265 # endif OBJ 266 # ifdef PTREE 267 { 268 pPointer PF = tCopy( r ); 269 270 pSeize( PorFHeader[ nesting ] ); 271 if ( r->tag != T_PROG ) { 272 pPointer *PFs; 273 274 PFs = &( pDEF( PorFHeader[ nesting ] ).PorFPFs ); 275 *PFs = ListAppend( *PFs , PF ); 276 } else { 277 pDEF( PorFHeader[ nesting ] ).GlobProg = PF; 278 } 279 pRelease( PorFHeader[ nesting ] ); 280 } 281 # endif PTREE 282 return (p); 283 } 284 285 /* 286 * deal with the parameter declaration for a routine. 287 * p is the namelist entry of the routine. 288 * formalist is the parse tree for the parameter declaration. 289 * formalist [0] T_LISTPP 290 * [1] pointer to a formal 291 * [2] pointer to next formal 292 * for by-value or by-reference formals, the formal is 293 * formal [0] T_PVAL or T_PVAR 294 * [1] pointer to id_list 295 * [2] pointer to type (error if not typeid) 296 * for function and procedure formals, the formal is 297 * formal [0] T_PFUNC or T_PPROC 298 * [1] pointer to id_list (error if more than one) 299 * [2] pointer to type (error if not typeid, or proc) 300 * [3] pointer to formalist for this routine. 301 */ 302 fparams(p, formal) 303 register struct nl *p; 304 struct tnode *formal; /* T_PFUNC or T_PPROC */ 305 { 306 (void) params(p, formal->pfunc_node.param_list); 307 p -> value[ NL_LINENO ] = formal->pfunc_node.line_no; 308 p -> ptr[ NL_FCHAIN ] = p -> chain; 309 p -> chain = NIL; 310 } 311 312 params(p, formalist) 313 register struct nl *p; 314 struct tnode *formalist; /* T_LISTPP */ 315 { 316 struct nl *chainp, *savedp; 317 struct nl *dp; 318 register struct tnode *formalp; /* an element of the formal list */ 319 register struct tnode *formal; /* a formal */ 320 struct tnode *typ, *idlist; 321 int w, o; 322 323 /* 324 * Enter the parameters 325 * and compute total size 326 */ 327 chainp = savedp = p; 328 329 # ifdef OBJ 330 o = 0; 331 # endif OBJ 332 # ifdef PC 333 /* 334 * parameters used to be allocated backwards, 335 * then fixed. for pc, they are allocated correctly. 336 * also, they are aligned. 337 */ 338 o = DPOFF2; 339 # endif PC 340 for (formalp = formalist; formalp != TR_NIL; 341 formalp = formalp->list_node.next) { 342 p = NLNIL; 343 formal = formalp->list_node.list; 344 if (formal == TR_NIL) 345 continue; 346 /* 347 * Parametric procedures 348 * don't have types !?! 349 */ 350 typ = formal->pfunc_node.type; 351 if ( typ == TR_NIL ) { 352 if ( formal->tag != T_PPROC ) { 353 error("Types must be specified for arguments"); 354 p = NLNIL; 355 } 356 } else { 357 if ( formal->tag == T_PPROC ) { 358 error("Procedures cannot have types"); 359 p = NLNIL; 360 } else { 361 if (typ->tag != T_TYID) { 362 error("Types for arguments can be specified only by using type identifiers"); 363 p = NLNIL; 364 } else { 365 p = gtype(typ); 366 } 367 } 368 } 369 for (idlist = formal->param.id_list; idlist != TR_NIL; 370 idlist = idlist->list_node.next) { 371 switch (formal->tag) { 372 default: 373 panic("funchdr2"); 374 case T_PVAL: 375 if (p != NLNIL) { 376 if (p->class == FILET) 377 error("Files cannot be passed by value"); 378 else if (p->nl_flags & NFILES) 379 error("Files cannot be a component of %ss passed by value", 380 nameof(p)); 381 } 382 # ifdef OBJ 383 w = lwidth(p); 384 o -= even(w); 385 # ifdef DEC11 386 dp = defnl((char *) idlist->list_node.list, 387 VAR, p, o); 388 # else 389 dp = defnl((char *) idlist->list_node.list, 390 VAR,p, (w < 2) ? o + 1 : o); 391 # endif DEC11 392 # endif OBJ 393 # ifdef PC 394 o = roundup(o, (long) A_STACK); 395 w = lwidth(p); 396 # ifndef DEC11 397 if (w <= sizeof(int)) { 398 o += sizeof(int) - w; 399 } 400 # endif not DEC11 401 dp = defnl((char *) idlist->list_node.list,VAR, 402 p, o); 403 o += w; 404 # endif PC 405 dp->nl_flags |= NMOD; 406 break; 407 case T_PVAR: 408 # ifdef OBJ 409 dp = defnl((char *) idlist->list_node.list, REF, 410 p, o -= sizeof ( int * ) ); 411 # endif OBJ 412 # ifdef PC 413 dp = defnl( (char *) idlist->list_node.list, REF, 414 p , 415 o = roundup( o , (long)A_STACK ) ); 416 o += sizeof(char *); 417 # endif PC 418 break; 419 case T_PFUNC: 420 if (idlist->list_node.next != TR_NIL) { 421 error("Each function argument must be declared separately"); 422 idlist->list_node.next = TR_NIL; 423 } 424 # ifdef OBJ 425 dp = defnl((char *) idlist->list_node.list,FFUNC, 426 p, o -= sizeof ( int * ) ); 427 # endif OBJ 428 # ifdef PC 429 dp = defnl( (char *) idlist->list_node.list , 430 FFUNC , p , 431 o = roundup( o , (long)A_STACK ) ); 432 o += sizeof(char *); 433 # endif PC 434 dp -> nl_flags |= NMOD; 435 fparams(dp, formal); 436 break; 437 case T_PPROC: 438 if (idlist->list_node.next != TR_NIL) { 439 error("Each procedure argument must be declared separately"); 440 idlist->list_node.next = TR_NIL; 441 } 442 # ifdef OBJ 443 dp = defnl((char *) idlist->list_node.list, 444 FPROC, p, o -= sizeof ( int * ) ); 445 # endif OBJ 446 # ifdef PC 447 dp = defnl( (char *) idlist->list_node.list , 448 FPROC , p, 449 o = roundup( o , (long)A_STACK ) ); 450 o += sizeof(char *); 451 # endif PC 452 dp -> nl_flags |= NMOD; 453 fparams(dp, formal); 454 break; 455 } 456 if (dp != NLNIL) { 457 # ifdef PC 458 dp -> extra_flags |= NPARAM; 459 # endif PC 460 chainp->chain = dp; 461 chainp = dp; 462 } 463 } 464 } 465 p = savedp; 466 # ifdef OBJ 467 /* 468 * Correct the naivete (naivety) 469 * of our above code to 470 * calculate offsets 471 */ 472 for (dp = p->chain; dp != NLNIL; dp = dp->chain) 473 dp->value[NL_OFFS] += -o + DPOFF2; 474 return (-o + DPOFF2); 475 # endif OBJ 476 # ifdef PC 477 return roundup( o , (long)A_STACK ); 478 # endif PC 479 } 480