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