xref: /csrg-svn/usr.bin/pascal/src/fdec.c (revision 3276)
1752Speter /* Copyright (c) 1979 Regents of the University of California */
2752Speter 
3*3276Smckusic static char sccsid[] = "@(#)fdec.c 1.18 03/16/81";
4752Speter 
5752Speter #include "whoami.h"
6752Speter #include "0.h"
7752Speter #include "tree.h"
8752Speter #include "opcode.h"
9752Speter #include "objfmt.h"
10752Speter #include "align.h"
11752Speter 
12752Speter /*
13752Speter  * this array keeps the pxp counters associated with
14752Speter  * functions and procedures, so that they can be output
15752Speter  * when their bodies are encountered
16752Speter  */
17752Speter int	bodycnts[ DSPLYSZ ];
18752Speter 
19752Speter #ifdef PC
20752Speter #   include "pc.h"
21752Speter #   include "pcops.h"
22752Speter #endif PC
23752Speter 
24752Speter #ifdef OBJ
25752Speter int	cntpatch;
26752Speter int	nfppatch;
27752Speter #endif OBJ
28752Speter 
29752Speter funcfwd(fp)
30752Speter 	struct nl *fp;
31752Speter {
32752Speter 
33752Speter 	    /*
34752Speter 	     *	save the counter for this function
35752Speter 	     */
36752Speter 	if ( monflg ) {
37752Speter 	    fp -> value[ NL_CNTR ] = bodycnts[ cbn ];
38752Speter 	}
39752Speter 	return (fp);
40752Speter }
41752Speter 
42752Speter /*
43752Speter  * Funcext marks the procedure or
44752Speter  * function external in the symbol
45752Speter  * table. Funcext should only be
46752Speter  * called if PC, and is an error
47752Speter  * otherwise.
48752Speter  */
49752Speter 
50752Speter funcext(fp)
51752Speter 	struct nl *fp;
52752Speter {
53752Speter 
54752Speter #ifdef PC
55752Speter  	if (opt('s')) {
56752Speter 		standard();
57752Speter 		error("External procedures and functions are not standard");
58752Speter 	} else {
59752Speter 		if (cbn == 1) {
60752Speter 			fp->ext_flags |= NEXTERN;
61825Speter 			stabefunc( fp -> symbol , fp -> class , line );
62752Speter 		}
63752Speter 		else
64752Speter 			error("External procedures and functions can only be declared at the outermost level.");
65752Speter 	}
66752Speter #endif PC
67752Speter #ifdef OBJ
68752Speter 	error("Procedures or functions cannot be declared external.");
69752Speter #endif OBJ
70752Speter 
71752Speter 	return(fp);
72752Speter }
73752Speter 
74752Speter /*
75752Speter  * Funcbody is called
76752Speter  * when the actual (resolved)
77752Speter  * declaration of a procedure is
78752Speter  * encountered. It puts the names
79752Speter  * of the (function) and parameters
80752Speter  * into the symbol table.
81752Speter  */
82752Speter funcbody(fp)
83752Speter 	struct nl *fp;
84752Speter {
85752Speter 	register struct nl *q, *p;
86752Speter 
87752Speter 	cbn++;
88752Speter 	if (cbn >= DSPLYSZ) {
89752Speter 		error("Too many levels of function/procedure nesting");
90752Speter 		pexit(ERRS);
91752Speter 	}
923222Smckusic 	sizes[cbn].om_max = sizes[cbn].curtmps.om_off = -DPOFF1;
93*3276Smckusic 	sizes[cbn].reg_max = -1;
94*3276Smckusic 	sizes[cbn].curtmps.reg_off = 0;
95752Speter 	gotos[cbn] = NIL;
96752Speter 	errcnt[cbn] = syneflg;
97834Speter 	parts[ cbn ] = NIL;
98752Speter 	dfiles[ cbn ] = FALSE;
99752Speter 	if (fp == NIL)
100752Speter 		return (NIL);
101752Speter 	/*
102752Speter 	 * Save the virtual name
103752Speter 	 * list stack pointer so
104752Speter 	 * the space can be freed
105752Speter 	 * later (funcend).
106752Speter 	 */
107752Speter 	fp->ptr[2] = nlp;
108752Speter 	if (fp->class != PROG) {
109752Speter 		for (q = fp->chain; q != NIL; q = q->chain) {
110752Speter 			enter(q);
111752Speter 		}
112752Speter 	}
113752Speter 	if (fp->class == FUNC) {
114752Speter 		/*
115752Speter 		 * For functions, enter the fvar
116752Speter 		 */
117752Speter 		enter(fp->ptr[NL_FVAR]);
118752Speter #		ifdef PC
119752Speter 		    q = fp -> ptr[ NL_FVAR ];
120*3276Smckusic 		    if (q -> ptr[ NL_OFFS ] != tmpalloc(leven(roundup(
121*3276Smckusic 			    (int)lwidth(q -> type), (long)align(q -> type))),
122*3276Smckusic 			q -> type, NOREG))
123*3276Smckusic 			    panic("func var");
124752Speter #		endif PC
125752Speter 	}
126752Speter #	ifdef PTREE
127752Speter 		/*
128752Speter 		 *	pick up the pointer to porf declaration
129752Speter 		 */
130752Speter 	    PorFHeader[ ++nesting ] = fp -> inTree;
131752Speter #	endif PTREE
132752Speter 	return (fp);
133752Speter }
134752Speter 
135752Speter /*
136752Speter  * Segend is called to check for
137752Speter  * unresolved variables, funcs and
138752Speter  * procs, and deliver unresolved and
139752Speter  * baduse error diagnostics at the
140752Speter  * end of a routine segment (a separately
141752Speter  * compiled segment that is not the
142752Speter  * main program) for PC. This
143752Speter  * routine should only be called
144752Speter  * by PC (not standard).
145752Speter  */
146752Speter  segend()
147752Speter  {
148752Speter 	register struct nl *p;
149752Speter 	register int i,b;
150752Speter 	char *cp;
151752Speter 
152752Speter #ifdef PC
153752Speter 	if (opt('s')) {
154752Speter 		standard();
155752Speter 		error("Separately compiled routine segments are not standard.");
156752Speter 	} else {
157752Speter 		b = cbn;
158752Speter 		for (i=0; i<077; i++) {
159752Speter 			for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) {
160752Speter 			switch (p->class) {
161752Speter 				case BADUSE:
162752Speter 					cp = 's';
163752Speter 					if (p->chain->ud_next == NIL)
164752Speter 						cp++;
165752Speter 					eholdnl();
166752Speter 					if (p->value[NL_KINDS] & ISUNDEF)
167752Speter 						nerror("%s undefined on line%s", p->symbol, cp);
168752Speter 					else
169752Speter 						nerror("%s improperly used on line%s", p->symbol, cp);
170752Speter 					pnumcnt = 10;
171752Speter 					pnums(p->chain);
172752Speter 					pchr('\n');
173752Speter 					break;
174752Speter 
175752Speter 				case FUNC:
176752Speter 				case PROC:
177752Speter 					if ((p->nl_flags & NFORWD) && ((p->ext_flags & NEXTERN) == 0))
178752Speter 						nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol);
179752Speter 					break;
180752Speter 
181752Speter 				case FVAR:
182752Speter 					if (((p->nl_flags & NMOD) == 0) && ((p->chain->ext_flags & NEXTERN) == 0))
183752Speter 						nerror("No assignment to the function variable");
184752Speter 					break;
185752Speter 			    }
186752Speter 			   }
187752Speter 			   disptab[i] = p;
188752Speter 		    }
189752Speter 	}
190752Speter #endif PC
191752Speter #ifdef OBJ
192752Speter 	error("Missing program statement and program body");
193752Speter #endif OBJ
194752Speter 
195752Speter }
196752Speter 
197752Speter 
198752Speter /*
199752Speter  * Level1 does level one processing for
200752Speter  * separately compiled routine segments
201752Speter  */
202752Speter level1()
203752Speter {
204752Speter 
205752Speter #	ifdef OBJ
206752Speter 	    error("Missing program statement");
207752Speter #	endif OBJ
208752Speter #	ifdef PC
209752Speter 	    if (opt('s')) {
210752Speter 		    standard();
211752Speter 		    error("Missing program statement");
212752Speter 	    }
213752Speter #	endif PC
214752Speter 
215752Speter 	cbn++;
2163222Smckusic 	sizes[cbn].om_max = sizes[cbn].curtmps.om_off = -DPOFF1;
217834Speter 	gotos[cbn] = NIL;
218834Speter 	errcnt[cbn] = syneflg;
219834Speter 	parts[ cbn ] = NIL;
220834Speter 	dfiles[ cbn ] = FALSE;
2213073Smckusic 	progseen = TRUE;
222752Speter }
223752Speter 
224752Speter 
225752Speter 
226752Speter pnums(p)
227752Speter 	struct udinfo *p;
228752Speter {
229752Speter 
230752Speter 	if (p->ud_next != NIL)
231752Speter 		pnums(p->ud_next);
232752Speter 	if (pnumcnt == 0) {
233752Speter 		printf("\n\t");
234752Speter 		pnumcnt = 20;
235752Speter 	}
236752Speter 	pnumcnt--;
237752Speter 	printf(" %d", p->ud_line);
238752Speter }
239752Speter 
240752Speter nerror(a1, a2, a3)
241752Speter {
242752Speter 
243752Speter 	if (Fp != NIL) {
244752Speter 		yySsync();
245752Speter #ifndef PI1
246752Speter 		if (opt('l'))
247752Speter 			yyoutline();
248752Speter #endif
249752Speter 		yysetfile(filename);
250752Speter 		printf("In %s %s:\n", classes[Fp->class], Fp->symbol);
251752Speter 		Fp = NIL;
252752Speter 		elineoff();
253752Speter 	}
254752Speter 	error(a1, a2, a3);
255752Speter }
256