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