xref: /csrg-svn/usr.bin/pascal/src/fdec.c (revision 3222)
1 /* Copyright (c) 1979 Regents of the University of California */
2 
3 static char sccsid[] = "@(#)fdec.c 1.17 03/11/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->ext_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 
87 	cbn++;
88 	if (cbn >= DSPLYSZ) {
89 		error("Too many levels of function/procedure nesting");
90 		pexit(ERRS);
91 	}
92 	sizes[cbn].om_max = sizes[cbn].curtmps.om_off = -DPOFF1;
93 	gotos[cbn] = NIL;
94 	errcnt[cbn] = syneflg;
95 	parts[ cbn ] = NIL;
96 	dfiles[ cbn ] = FALSE;
97 	if (fp == NIL)
98 		return (NIL);
99 	/*
100 	 * Save the virtual name
101 	 * list stack pointer so
102 	 * the space can be freed
103 	 * later (funcend).
104 	 */
105 	fp->ptr[2] = nlp;
106 	if (fp->class != PROG) {
107 		for (q = fp->chain; q != NIL; q = q->chain) {
108 			enter(q);
109 		}
110 	}
111 	if (fp->class == FUNC) {
112 		/*
113 		 * For functions, enter the fvar
114 		 */
115 		enter(fp->ptr[NL_FVAR]);
116 #		ifdef PC
117 		    q = fp -> ptr[ NL_FVAR ];
118 		    sizes[cbn].curtmps.om_off -= lwidth( q -> type );
119 		    sizes[cbn].om_max = sizes[cbn].curtmps.om_off;
120 #		endif PC
121 	}
122 #	ifdef PTREE
123 		/*
124 		 *	pick up the pointer to porf declaration
125 		 */
126 	    PorFHeader[ ++nesting ] = fp -> inTree;
127 #	endif PTREE
128 	return (fp);
129 }
130 
131 /*
132  * Segend is called to check for
133  * unresolved variables, funcs and
134  * procs, and deliver unresolved and
135  * baduse error diagnostics at the
136  * end of a routine segment (a separately
137  * compiled segment that is not the
138  * main program) for PC. This
139  * routine should only be called
140  * by PC (not standard).
141  */
142  segend()
143  {
144 	register struct nl *p;
145 	register int i,b;
146 	char *cp;
147 
148 #ifdef PC
149 	if (opt('s')) {
150 		standard();
151 		error("Separately compiled routine segments are not standard.");
152 	} else {
153 		b = cbn;
154 		for (i=0; i<077; i++) {
155 			for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) {
156 			switch (p->class) {
157 				case BADUSE:
158 					cp = 's';
159 					if (p->chain->ud_next == NIL)
160 						cp++;
161 					eholdnl();
162 					if (p->value[NL_KINDS] & ISUNDEF)
163 						nerror("%s undefined on line%s", p->symbol, cp);
164 					else
165 						nerror("%s improperly used on line%s", p->symbol, cp);
166 					pnumcnt = 10;
167 					pnums(p->chain);
168 					pchr('\n');
169 					break;
170 
171 				case FUNC:
172 				case PROC:
173 					if ((p->nl_flags & NFORWD) && ((p->ext_flags & NEXTERN) == 0))
174 						nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol);
175 					break;
176 
177 				case FVAR:
178 					if (((p->nl_flags & NMOD) == 0) && ((p->chain->ext_flags & NEXTERN) == 0))
179 						nerror("No assignment to the function variable");
180 					break;
181 			    }
182 			   }
183 			   disptab[i] = p;
184 		    }
185 	}
186 #endif PC
187 #ifdef OBJ
188 	error("Missing program statement and program body");
189 #endif OBJ
190 
191 }
192 
193 
194 /*
195  * Level1 does level one processing for
196  * separately compiled routine segments
197  */
198 level1()
199 {
200 
201 #	ifdef OBJ
202 	    error("Missing program statement");
203 #	endif OBJ
204 #	ifdef PC
205 	    if (opt('s')) {
206 		    standard();
207 		    error("Missing program statement");
208 	    }
209 #	endif PC
210 
211 	cbn++;
212 	sizes[cbn].om_max = sizes[cbn].curtmps.om_off = -DPOFF1;
213 	gotos[cbn] = NIL;
214 	errcnt[cbn] = syneflg;
215 	parts[ cbn ] = NIL;
216 	dfiles[ cbn ] = FALSE;
217 	progseen = TRUE;
218 }
219 
220 
221 
222 pnums(p)
223 	struct udinfo *p;
224 {
225 
226 	if (p->ud_next != NIL)
227 		pnums(p->ud_next);
228 	if (pnumcnt == 0) {
229 		printf("\n\t");
230 		pnumcnt = 20;
231 	}
232 	pnumcnt--;
233 	printf(" %d", p->ud_line);
234 }
235 
236 nerror(a1, a2, a3)
237 {
238 
239 	if (Fp != NIL) {
240 		yySsync();
241 #ifndef PI1
242 		if (opt('l'))
243 			yyoutline();
244 #endif
245 		yysetfile(filename);
246 		printf("In %s %s:\n", classes[Fp->class], Fp->symbol);
247 		Fp = NIL;
248 		elineoff();
249 	}
250 	error(a1, a2, a3);
251 }
252