1 /* Copyright (c) 1979 Regents of the University of California */ 2 3 static char sccsid[] = "@(#)fhdr.c 1.1 03/11/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 int *rll; 46 struct nl *cp, *dp, *sp; 47 int w, s, o, *pp; 48 49 if (inpflist(r[2])) { 50 opush('l'); 51 yyretrieve(); /* kludge */ 52 } 53 pfcnt++; 54 parts[ cbn ] |= RPRT; 55 line = r[1]; 56 if (r[3] == NIL && (p=lookup1(r[2])) != NIL && bn == cbn) { 57 /* 58 * Symbol already defined 59 * in this block. it is either 60 * a redeclared symbol (error) 61 * a forward declaration, 62 * or an external declaration. 63 */ 64 if ((p->class == FUNC || p->class == PROC) && (p->nl_flags & NFORWD) != 0) { 65 /* 66 * Grammar doesnt forbid 67 * types on a resolution 68 * of a forward function 69 * declaration. 70 */ 71 if (p->class == FUNC && r[4]) 72 error("Function type should be given only in forward declaration"); 73 /* 74 * get another counter for the actual 75 */ 76 if ( monflg ) { 77 bodycnts[ cbn ] = getcnt(); 78 } 79 # ifdef PC 80 enclosing[ cbn ] = p -> symbol; 81 # endif PC 82 # ifdef PTREE 83 /* 84 * mark this proc/func as forward 85 * in the pTree. 86 */ 87 pDEF( p -> inTree ).PorFForward = TRUE; 88 # endif PTREE 89 return (p); 90 } 91 } 92 93 /* if a routine segment is being compiled, 94 * do level one processing. 95 */ 96 97 if ((r[0] != T_PROG) && (!progseen)) 98 level1(); 99 100 101 /* 102 * Declare the prog/proc/func 103 */ 104 switch (r[0]) { 105 case T_PROG: 106 progseen = TRUE; 107 if (opt('z')) 108 monflg = TRUE; 109 program = p = defnl(r[2], PROG, 0, 0); 110 p->value[3] = r[1]; 111 break; 112 case T_PDEC: 113 if (r[4] != NIL) 114 error("Procedures do not have types, only functions do"); 115 p = enter(defnl(r[2], PROC, 0, 0)); 116 p->nl_flags |= NMOD; 117 # ifdef PC 118 enclosing[ cbn ] = r[2]; 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 # endif PC 150 break; 151 default: 152 panic("funchdr"); 153 } 154 if (r[0] != T_PROG) { 155 /* 156 * Mark this proc/func as 157 * being forward declared 158 */ 159 p->nl_flags |= NFORWD; 160 /* 161 * Enter the parameters 162 * in the next block for 163 * the time being 164 */ 165 if (++cbn >= DSPLYSZ) { 166 error("Procedure/function nesting too deep"); 167 pexit(ERRS); 168 } 169 /* 170 * For functions, the function variable 171 */ 172 if (p->class == FUNC) { 173 # ifdef OBJ 174 cp = defnl(r[2], FVAR, p->type, 0); 175 # endif OBJ 176 # ifdef PC 177 /* 178 * fvars used to be allocated and deallocated 179 * by the caller right before the arguments. 180 * the offset of the fvar was kept in 181 * value[NL_OFFS] of function (very wierd, 182 * but see asgnop). 183 * now, they are locals to the function 184 * with the offset kept in the fvar. 185 */ 186 187 cp = defnl(r[2], FVAR, p->type, 188 -(roundup((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 cp = sp = p; 199 200 # ifdef OBJ 201 o = 0; 202 # endif OBJ 203 # ifdef PC 204 /* 205 * parameters used to be allocated backwards, 206 * then fixed. for pc, they are allocated correctly. 207 * also, they are aligned. 208 */ 209 o = DPOFF2; 210 # endif PC 211 for (rl = r[3]; rl != NIL; rl = rl[2]) { 212 p = NIL; 213 if (rl[1] == NIL) 214 continue; 215 /* 216 * Parametric procedures 217 * don't have types !?! 218 */ 219 if (rl[1][0] != T_PPROC) { 220 rll = rl[1][2]; 221 if (rll[0] != T_TYID) { 222 error("Types for arguments can be specified only by using type identifiers"); 223 p = NIL; 224 } else 225 p = gtype(rll); 226 } 227 for (il = rl[1][1]; il != NIL; il = il[2]) { 228 switch (rl[1][0]) { 229 default: 230 panic("funchdr2"); 231 case T_PVAL: 232 if (p != NIL) { 233 if (p->class == FILET) 234 error("Files cannot be passed by value"); 235 else if (p->nl_flags & NFILES) 236 error("Files cannot be a component of %ss passed by value", 237 nameof(p)); 238 } 239 # ifdef OBJ 240 w = width(p); 241 o -= even(w); 242 # ifdef DEC11 243 dp = defnl(il[1], VAR, p, o); 244 # else 245 dp = defnl(il[1], VAR, p, 246 (w < 2) ? o + 1 : o); 247 # endif DEC11 248 # endif OBJ 249 # ifdef PC 250 dp = defnl( il[1] , VAR , p 251 , o = roundup( o , (long)A_STACK ) ); 252 o += width( p ); 253 # endif PC 254 dp->nl_flags |= NMOD; 255 break; 256 case T_PVAR: 257 # ifdef OBJ 258 dp = defnl(il[1], REF, p, o -= sizeof ( int * ) ); 259 # endif OBJ 260 # ifdef PC 261 dp = defnl( il[1] , REF , p 262 , o = roundup( o , (long)A_STACK ) ); 263 o += sizeof(char *); 264 # endif PC 265 break; 266 case T_PFUNC: 267 # ifdef OBJ 268 dp = defnl(il[1], FFUNC, p, o -= sizeof ( int * ) ); 269 # endif OBJ 270 # ifdef PC 271 dp = defnl( il[1] , FFUNC , p 272 , o = roundup( o , (long)A_STACK ) ); 273 o += sizeof(char *); 274 # endif PC 275 dp -> nl_flags |= NMOD; 276 break; 277 case T_PPROC: 278 # ifdef OBJ 279 dp = defnl(il[1], FPROC, p, o -= sizeof ( int * ) ); 280 # endif OBJ 281 # ifdef PC 282 dp = defnl( il[1] , FPROC , p 283 , o = roundup( o , (long)A_STACK ) ); 284 o += sizeof(char *); 285 # endif PC 286 dp -> nl_flags |= NMOD; 287 break; 288 } 289 if (dp != NIL) { 290 cp->chain = dp; 291 cp = dp; 292 } 293 } 294 } 295 cbn--; 296 p = sp; 297 # ifdef OBJ 298 p->value[NL_OFFS] = -o+DPOFF2; 299 /* 300 * Correct the naivete (naievity) 301 * of our above code to 302 * calculate offsets 303 */ 304 for (il = p->chain; il != NIL; il = il->chain) 305 il->value[NL_OFFS] += p->value[NL_OFFS]; 306 # endif OBJ 307 # ifdef PC 308 p -> value[ NL_OFFS ] = roundup( o , (long)A_STACK ); 309 # endif PC 310 } else { 311 /* 312 * The wonderful 313 * program statement! 314 */ 315 # ifdef OBJ 316 if (monflg) { 317 put(1, O_PXPBUF); 318 cntpatch = put(2, O_CASE4, (long)0); 319 nfppatch = put(2, O_CASE4, (long)0); 320 } 321 # endif OBJ 322 cp = p; 323 for (rl = r[3]; rl; rl = rl[2]) { 324 if (rl[1] == NIL) 325 continue; 326 dp = defnl(rl[1], VAR, 0, 0); 327 cp->chain = dp; 328 cp = dp; 329 } 330 } 331 /* 332 * Define a branch at 333 * the "entry point" of 334 * the prog/proc/func. 335 */ 336 p->entloc = getlab(); 337 if (monflg) { 338 bodycnts[ cbn ] = getcnt(); 339 p->value[ NL_CNTR ] = 0; 340 } 341 # ifdef OBJ 342 put(2, O_TRA4, (long)p->entloc); 343 # endif OBJ 344 # ifdef PTREE 345 { 346 pPointer PF = tCopy( r ); 347 348 pSeize( PorFHeader[ nesting ] ); 349 if ( r[0] != T_PROG ) { 350 pPointer *PFs; 351 352 PFs = &( pDEF( PorFHeader[ nesting ] ).PorFPFs ); 353 *PFs = ListAppend( *PFs , PF ); 354 } else { 355 pDEF( PorFHeader[ nesting ] ).GlobProg = PF; 356 } 357 pRelease( PorFHeader[ nesting ] ); 358 } 359 # endif PTREE 360 return (p); 361 } 362