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