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