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