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