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