xref: /csrg-svn/usr.bin/pascal/src/fdec.c (revision 7715)
1 /* Copyright (c) 1979 Regents of the University of California */
2 
3 static char sccsid[] = "@(#)fdec.c 1.21 08/11/82";
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 funcfwd(fp)
30 	struct nl *fp;
31 {
32 
33 	    /*
34 	     *	save the counter for this function
35 	     */
36 	if ( monflg ) {
37 	    fp -> value[ NL_CNTR ] = bodycnts[ cbn ];
38 	}
39 	return (fp);
40 }
41 
42 /*
43  * Funcext marks the procedure or
44  * function external in the symbol
45  * table. Funcext should only be
46  * called if PC, and is an error
47  * otherwise.
48  */
49 
50 funcext(fp)
51 	struct nl *fp;
52 {
53 
54 #ifdef OBJ
55 	error("Procedures or functions cannot be declared external.");
56 #endif OBJ
57 
58 #ifdef PC
59 	    /*
60 	     *	save the counter for this function
61 	     */
62 	if ( monflg ) {
63 	    fp -> value[ NL_CNTR ] = bodycnts[ cbn ];
64 	}
65  	if (opt('s')) {
66 		standard();
67 		error("External procedures and functions are not standard");
68 	} else {
69 		if (cbn == 1) {
70 			fp->extra_flags |= NEXTERN;
71 			stabefunc( fp -> symbol , fp -> class , line );
72 		}
73 		else
74 			error("External procedures and functions can only be declared at the outermost level.");
75 	}
76 #endif PC
77 
78 	return(fp);
79 }
80 
81 /*
82  * Funcbody is called
83  * when the actual (resolved)
84  * declaration of a procedure is
85  * encountered. It puts the names
86  * of the (function) and parameters
87  * into the symbol table.
88  */
89 funcbody(fp)
90 	struct nl *fp;
91 {
92 	register struct nl *q, *p;
93 	struct nl	*functemp;
94 
95 	cbn++;
96 	if (cbn >= DSPLYSZ) {
97 		error("Too many levels of function/procedure nesting");
98 		pexit(ERRS);
99 	}
100 	sizes[cbn].om_max = sizes[cbn].curtmps.om_off = -DPOFF1;
101 	sizes[cbn].reg_max = -1;
102 	sizes[cbn].curtmps.reg_off = 0;
103 	gotos[cbn] = NIL;
104 	errcnt[cbn] = syneflg;
105 	parts[ cbn ] = NIL;
106 	dfiles[ cbn ] = FALSE;
107 	if (fp == NIL)
108 		return (NIL);
109 	/*
110 	 * Save the virtual name
111 	 * list stack pointer so
112 	 * the space can be freed
113 	 * later (funcend).
114 	 */
115 	fp->ptr[2] = nlp;
116 	if (fp->class != PROG) {
117 		for (q = fp->chain; q != NIL; q = q->chain) {
118 			enter(q);
119 #			ifdef PC
120 			    q -> extra_flags |= NPARAM;
121 #			endif PC
122 		}
123 	}
124 	if (fp->class == FUNC) {
125 		/*
126 		 * For functions, enter the fvar
127 		 */
128 		enter(fp->ptr[NL_FVAR]);
129 #		ifdef PC
130 		    q = fp -> ptr[ NL_FVAR ];
131 		    if (q -> type != NIL ) {
132 			functemp = tmpalloc(
133 					leven(
134 					    roundup(
135 						(int)lwidth(q -> type),
136 						(long)align(q -> type))),
137 					q -> type, NOREG);
138 			if ( q -> ptr[NL_OFFS] != functemp->value[NL_OFFS] )
139 			    panic("func var");
140 		    }
141 		    q -> extra_flags |= functemp -> extra_flags;
142 #		endif PC
143 	}
144 #	ifdef PTREE
145 		/*
146 		 *	pick up the pointer to porf declaration
147 		 */
148 	    PorFHeader[ ++nesting ] = fp -> inTree;
149 #	endif PTREE
150 	return (fp);
151 }
152 
153 /*
154  * Segend is called to check for
155  * unresolved variables, funcs and
156  * procs, and deliver unresolved and
157  * baduse error diagnostics at the
158  * end of a routine segment (a separately
159  * compiled segment that is not the
160  * main program) for PC. This
161  * routine should only be called
162  * by PC (not standard).
163  */
164  segend()
165  {
166 	register struct nl *p;
167 	register int i,b;
168 	char *cp;
169 
170 #ifdef PC
171 	if (opt('s')) {
172 		standard();
173 		error("Separately compiled routine segments are not standard.");
174 	} else {
175 		b = cbn;
176 		for (i=0; i<077; i++) {
177 			for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) {
178 			switch (p->class) {
179 				case BADUSE:
180 					cp = 's';
181 					if (p->chain->ud_next == NIL)
182 						cp++;
183 					eholdnl();
184 					if (p->value[NL_KINDS] & ISUNDEF)
185 						nerror("%s undefined on line%s", p->symbol, cp);
186 					else
187 						nerror("%s improperly used on line%s", p->symbol, cp);
188 					pnumcnt = 10;
189 					pnums(p->chain);
190 					pchr('\n');
191 					break;
192 
193 				case FUNC:
194 				case PROC:
195 					if ((p->nl_flags & NFORWD) &&
196 					    ((p->extra_flags & NEXTERN) == 0))
197 						nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol);
198 					break;
199 
200 				case FVAR:
201 					if (((p->nl_flags & NMOD) == 0) &&
202 					    ((p->chain->extra_flags & NEXTERN) == 0))
203 						nerror("No assignment to the function variable");
204 					break;
205 			    }
206 			   }
207 			   disptab[i] = p;
208 		    }
209 	}
210 #endif PC
211 #ifdef OBJ
212 	error("Missing program statement and program body");
213 #endif OBJ
214 
215 }
216 
217 
218 /*
219  * Level1 does level one processing for
220  * separately compiled routine segments
221  */
222 level1()
223 {
224 
225 #	ifdef OBJ
226 	    error("Missing program statement");
227 #	endif OBJ
228 #	ifdef PC
229 	    if (opt('s')) {
230 		    standard();
231 		    error("Missing program statement");
232 	    }
233 #	endif PC
234 
235 	cbn++;
236 	sizes[cbn].om_max = sizes[cbn].curtmps.om_off = -DPOFF1;
237 	gotos[cbn] = NIL;
238 	errcnt[cbn] = syneflg;
239 	parts[ cbn ] = NIL;
240 	dfiles[ cbn ] = FALSE;
241 	progseen = TRUE;
242 }
243 
244 
245 
246 pnums(p)
247 	struct udinfo *p;
248 {
249 
250 	if (p->ud_next != NIL)
251 		pnums(p->ud_next);
252 	if (pnumcnt == 0) {
253 		printf("\n\t");
254 		pnumcnt = 20;
255 	}
256 	pnumcnt--;
257 	printf(" %d", p->ud_line);
258 }
259 
260 nerror(a1, a2, a3)
261 {
262 
263 	if (Fp != NIL) {
264 		yySsync();
265 #ifndef PI1
266 		if (opt('l'))
267 			yyoutline();
268 #endif
269 		yysetfile(filename);
270 		printf("In %s %s:\n", classes[Fp->class], Fp->symbol);
271 		Fp = NIL;
272 		elineoff();
273 	}
274 	error(a1, a2, a3);
275 }
276