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