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