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