[unix-history] / src / pi / fdec.c

/* Copyright (c) 1979 Regents of the University of California */
#
/*
 * pi - Pascal interpreter code translator
 *
 * Charles Haley, Bill Joy UCB
 * Version 1.2 January 1979
 */

#include "0.h"
#include "tree.h"
#include "opcode.h"

int	cntpatch;
int	nfppatch;

/*
 * Funchdr inserts
 * declaration of a the
 * prog/proc/func into the
 * namelist. It also handles
 * the arguments and puts out
 * a transfer which defines
 * the entry point of a procedure.
 */

funchdr(r)
	int *r;
{
	register struct nl *p;
	register *il, **rl;
	int *rll;
	struct nl *cp, *dp, *sp;
	int o, *pp;

	if (inpflist(r[2])) {
		opush('l');
		yyretrieve();	/* kludge */
	}
	pfcnt++;
	line = r[1];
	if (r[3] == NIL && (p=lookup1(r[2])) != NIL && bn == cbn) {
		/*
		 * Symbol already defined
		 * in this block. it is either
		 * a redeclared symbol (error)
		 * or a forward declaration.
		 */
		if ((p->class == FUNC || p->class == PROC) && (p->nl_flags & NFORWD) != 0) {
			/*
			 * Grammar doesnt forbid
			 * types on a resolution
			 * of a forward function
			 * declaration.
			 */
			if (p->class == FUNC && r[4])
				error("Function type should be given only in forward declaration");
			return (p);
		}
	}
	/*
	 * Declare the prog/proc/func
	 */
	switch (r[0]) {
		case T_PROG:
			if (opt('z'))
				monflg++;
			program = p = defnl(r[2], PROG, 0, 0);
			p->value[3] = r[1];
			break;
		case T_PDEC:
			if (r[4] != NIL)
				error("Procedures do not have types, only functions do");
			p = enter(defnl(r[2], PROC, 0, 0));
			p->nl_flags =| NMOD;
			break;
		case T_FDEC:
			il = r[4];
			if (il == NIL)
				error("Function type must be specified");
			else if (il[0] != T_TYID) {
				il = NIL;
				error("Function type can be specified only by using a type identifier");
			} else
				il = gtype(il);
			p = enter(defnl(r[2], FUNC, il, NIL));
			p->nl_flags =| NMOD;
			/*
			 * An arbitrary restriction
			 */
			switch (o = classify(p->type)) {
				case TFILE:
				case TARY:
				case TREC:
				case TSET:
				case TSTR:
					warning();
					if (opt('s'))
						standard();
					error("Functions should not return %ss", clnames[o]);
			}
			break;
		default:
			panic("funchdr");
		}
	if (r[0] != T_PROG) {
		/*
		 * Mark this proc/func as
		 * begin forward declared
		 */
		p->nl_flags =| NFORWD;
		/*
		 * Enter the parameters
		 * in the next block for
		 * the time being
		 */
		if (++cbn >= DSPLYSZ) {
			error("Procedure/function nesting too deep");
			pexit(ERRS);
		}
		/*
		 * For functions, the function variable
		 */
		if (p->class == FUNC) {
			cp = defnl(r[2], FVAR, p->type, 0);
			cp->chain = p;
			p->value[NL_FVAR] = cp;
		}
		/*
		 * Enter the parameters
		 * and compute total size
		 */
		cp = sp = p;
		o = 0;
		for (rl = r[3]; rl != NIL; rl = rl[2]) {
			p = NIL;
			if (rl[1] == NIL)
				continue;
			/*
			 * Parametric procedures
			 * don't have types !?!
			 */
			if (rl[1][0] != T_PPROC) {
				rll = rl[1][2];
				if (rll[0] != T_TYID) {
					error("Types for arguments can be specified only by using type identifiers");
					p = NIL;
				} else
					p = gtype(rll);
			}
			for (il = rl[1][1]; il != NIL; il = il[2]) {
				switch (rl[1][0]) {
					default:
						panic("funchdr2");
					case T_PVAL:
						if (p != NIL) {
							if (p->class == FILE)
								error("Files cannot be passed by value");
							else if (p->nl_flags & NFILES)
								error("Files cannot be a component of %ss passed by value",
									nameof(p));
						}
						dp = defnl(il[1], VAR, p, o=- even(width(p)));
						dp->nl_flags =| NMOD;
						break;
					case T_PVAR:
						dp = defnl(il[1], REF, p, o=- 2);
						break;
					case T_PFUNC:
					case T_PPROC:
						error("Procedure/function parameters not implemented");
						continue;
					}
				if (dp != NIL) {
					cp->chain = dp;
					cp = dp;
				}
			}
		}
		cbn--;
		p = sp;
		p->value[NL_OFFS] = -o+DPOFF2;
		/*
		 * Correct the naievity
		 * of our above code to
		 * calculate offsets
		 */
		for (il = p->chain; il != NIL; il = il->chain)
			il->value[NL_OFFS] =+ p->value[NL_OFFS];
	} else { 
		/*
		 * The wonderful
		 * program statement!
		 */
		if (monflg) {
			cntpatch = put2(O_PXPBUF, 0);
			nfppatch = put3(NIL, 0, 0);
		}
		cp = p;
		for (rl = r[3]; rl; rl = rl[2]) {
			if (rl[1] == NIL)
				continue;
			dp = defnl(rl[1], VAR, 0, 0);
			cp->chain = dp;
			cp = dp;
		}
	}
	/*
	 * Define a branch at
	 * the "entry point" of
	 * the prog/proc/func.
	 */
	p->value[NL_LOC] = getlab();
	if (monflg) {
		put2(O_TRACNT, p->value[NL_LOC]);
		putcnt();
	} else
		put2(O_TRA, p->value[NL_LOC]);
	return (p);
}

funcfwd(fp)
	struct nl *fp;
{

	return (fp);
}

/*
 * Funcbody is called
 * when the actual (resolved)
 * declaration of a procedure is
 * encountered. It puts the names
 * of the (function) and parameters
 * into the symbol table.
 */
funcbody(fp)
	struct nl *fp;
{
	register struct nl *q, *p;

	cbn++;
	if (cbn >= DSPLYSZ) {
		error("Too many levels of function/procedure nesting");
		pexit(ERRS);
	}
	sizes[cbn].om_off = 0;
	sizes[cbn].om_max = 0;
	gotos[cbn] = NIL;
	errcnt[cbn] = syneflg;
	parts = NIL;
	if (fp == NIL)
		return (NIL);
	/*
	 * Save the virtual name
	 * list stack pointer so
	 * the space can be freed
	 * later (funcend).
	 */
	fp->value[2] = nlp;
	if (fp->class != PROG)
		for (q = fp->chain; q != NIL; q = q->chain)
			enter(q);
	if (fp->class == FUNC) {
		/*
		 * For functions, enter the fvar
		 */
		enter(fp->value[NL_FVAR]);
	}
	return (fp);
}

struct	nl *Fp;
int	pnumcnt;
/*
 * Funcend is called to
 * finish a block by generating
 * the code for the statements.
 * It then looks for unresolved declarations
 * of labels, procedures and functions,
 * and cleans up the name list.
 * For the program, it checks the
 * semantics of the program
 * statement (yuchh).
 */
funcend(fp, bundle, endline)
	struct nl *fp;
	int *bundle;
	int endline;
{
	register struct nl *p;
	register int i, b;
	int var, inp, out, chkref, *blk;
	struct nl *iop;
	char *cp;
	extern int cntstat;

	cntstat = 0;
/*
	yyoutline();
*/
	if (program != NIL)
		line = program->value[3];
	blk = bundle[2];
	if (fp == NIL) {
		cbn--;
		return;
	}
	/*
	 * Patch the branch to the
	 * entry point of the function
	 */
	patch(fp->value[NL_LOC]);
	/*
	 * Put out the block entrance code and the block name.
	 * the CONG is overlaid by a patch later!
	 */
	var = put1(cbn == 1 && opt('p') == 0 ? O_NODUMP: O_BEG);
	put3(O_CONG, 8, fp->symbol);
	put2(NIL, bundle[1]);
	if (fp->class == PROG) {
		/*
		 * The glorious buffers option.
		 *          0 = don't buffer output
		 *          1 = line buffer output
		 *          2 = 512 byte buffer output
		 */
		if (opt('b') != 1)
			put1(O_BUFF | opt('b') << 8);
		inp = 0;
		out = 0;
		for (p = fp->chain; p != NIL; p = p->chain) {
			if (strcmp(p->symbol, "input") == 0) {
				inp++;
				continue;
			}
			if (strcmp(p->symbol, "output") == 0) {
				out++;
				continue;
			}
			iop = lookup1(p->symbol);
			if (iop == NIL || bn != cbn) {
				error("File %s listed in program statement but not declared", p->symbol);
				continue;
			}
			if (iop->class != VAR) {
				error("File %s listed in program statement but declared as a %s", p->symbol, classes[iop->class]);
				continue;
			}
			if (iop->type == NIL)
				continue;
			if (iop->type->class != FILE) {
				error("File %s listed in program statement but defined as %s",
					p->symbol, nameof(iop->type));
				continue;
			}
			put2(O_LV | bn << 9, iop->value[NL_OFFS]);
			b = p->symbol;
			while (b->pchar != '\0')
				b++;
			i = b - p->symbol;
			put3(O_CONG, i, p->symbol);
			put2(O_DEFNAME | i << 8, text(iop->type) ? 0: width(iop->type->type));
		}
		if (out == 0 && fp->chain != NIL) {
			recovered();
			error("The file output must appear in the program statement file list");
		}
	}
	/*
	 * Process the prog/proc/func body
	 */
	noreach = 0;
	line = bundle[1];
	statlist(blk);
	if (cbn== 1 && monflg != 0) {
		patchfil(cntpatch, cnts);
		patchfil(nfppatch, pfcnt);
	}
	if (fp->class == PROG && inp == 0 && (input->nl_flags & (NUSED|NMOD)) != 0) {
		recovered();
		error("Input is used but not defined in the program statement");
	}
	/*
	 * Clean up the symbol table displays and check for unresolves
	 */
	line = endline;
	b = cbn;
	Fp = fp;
	chkref = syneflg == errcnt[cbn] && opt('w') == 0;
	for (i = 0; i <= 077; i++) {
		for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) {
			/*
			 * Check for variables defined
			 * but not referenced 
			 */
			if (chkref && p->symbol != NIL)
			switch (p->class) {
				case FIELD:
					/*
					 * If the corresponding record is
					 * unused, we shouldn't complain about
					 * the fields.
					 */
				default:
					if ((p->nl_flags & (NUSED|NMOD)) == 0) {
						warning();
						nerror("%s %s is neither used nor set", classes[p->class], p->symbol);
						break;
					}
					/*
					 * If a var parameter is either
					 * modified or used that is enough.
					 */
					if (p->class == REF)
						continue;
					if ((p->nl_flags & NUSED) == 0) {
						warning();
						nerror("%s %s is never used", classes[p->class], p->symbol);
						break;
					}
					if ((p->nl_flags & NMOD) == 0) {
						warning();
						nerror("%s %s is used but never set", classes[p->class], p->symbol);
						break;
					}
				case LABEL:
				case FVAR:
				case BADUSE:
					break;
			}
			switch (p->class) {
				case BADUSE:
					cp = "s";
					if (p->chain->ud_next == NIL)
						cp++;
					eholdnl();
					if (p->value[NL_KINDS] & ISUNDEF)
						nerror("%s undefined on line%s", p->symbol, cp);
					else
						nerror("%s improperly used on line%s", p->symbol, cp);
					pnumcnt = 10;
					pnums(p->chain);
					putchar('\n');
					break;

				case FUNC:
				case PROC:
					if (p->nl_flags & NFORWD)
						nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol);
					break;

				case LABEL:
					if (p->nl_flags & NFORWD)
						nerror("label %s was declared but not defined", p->symbol);
					break;
				case FVAR:
					if ((p->nl_flags & NMOD) == 0)
						nerror("No assignment to the function variable");
					break;
			}
		}
		/*
		 * Pop this symbol
		 * table slot
		 */
		disptab[i] = p;
	}

	put1(O_END);
#ifdef DEBUG
	dumpnl(fp->value[2], fp->symbol);
#endif
	/*
	 * Restore the
	 * (virtual) name list
	 * position
	 */
	nlfree(fp->value[2]);
	/*
	 * Proc/func has been
	 * resolved
	 */
	fp->nl_flags =& ~NFORWD;
	/*
	 * Patch the beg
	 * of the proc/func to
	 * the proper variable size
	 */
	i = sizes[cbn].om_max;
	if (sizes[cbn].om_max < -50000.)
		nerror("Storage requirement of %ld bytes exceeds hardware capacity", -sizes[cbn].om_max);
	if (Fp == NIL)
		elineon();
	patchfil(var, i);
	cbn--;
	if (inpflist(fp->symbol)) {
		opop('l');
	}
}

pnums(p)
	struct udinfo *p;
{

	if (p->ud_next != NIL)
		pnums(p->ud_next);
	if (pnumcnt == 0) {
		printf("\n\t");
		pnumcnt = 20;
	}
	pnumcnt--;
	printf(" %d", p->ud_line);
}

nerror(a1, a2, a3)
{

	if (Fp != NIL) {
		yySsync();
#ifndef PI1
		if (opt('l'))
			yyoutline();
#endif
		yysetfile(filename);
		printf("In %s %s:\n", classes[Fp->class], Fp->symbol);
		Fp = NIL;
		elineoff();
	}
	error(a1, a2, a3);
}
Commit	Line	Data
4ea2d4e7 CH	1	/* Copyright (c) 1979 Regents of the University of California */
	2	#
	3	/*
	4	* pi - Pascal interpreter code translator
	5	*
	6	* Charles Haley, Bill Joy UCB
	7	* Version 1.2 January 1979
	8	*/
	9
	10	#include "0.h"
	11	#include "tree.h"
	12	#include "opcode.h"
	13
	14	int cntpatch;
	15	int nfppatch;
	16
	17	/*
	18	* Funchdr inserts
	19	* declaration of a the
	20	* prog/proc/func into the
	21	* namelist. It also handles
	22	* the arguments and puts out
	23	* a transfer which defines
	24	* the entry point of a procedure.
	25	*/
	26
	27	funchdr(r)
	28	int *r;
	29	{
	30	register struct nl *p;
	31	register il, *rl;
	32	int *rll;
	33	struct nl cp, dp, *sp;
	34	int o, *pp;
	35
	36	if (inpflist(r[2])) {
	37	opush('l');
	38	yyretrieve(); /* kludge */
	39	}
	40	pfcnt++;
	41	line = r[1];
	42	if (r[3] == NIL && (p=lookup1(r[2])) != NIL && bn == cbn) {
	43	/*
	44	* Symbol already defined
	45	* in this block. it is either
	46	* a redeclared symbol (error)
	47	* or a forward declaration.
	48	*/
	49	if ((p->class == FUNC \|\| p->class == PROC) && (p->nl_flags & NFORWD) != 0) {
	50	/*
	51	* Grammar doesnt forbid
	52	* types on a resolution
	53	* of a forward function
	54	* declaration.
	55	*/
	56	if (p->class == FUNC && r[4])
	57	error("Function type should be given only in forward declaration");
	58	return (p);
	59	}
	60	}
	61	/*
	62	* Declare the prog/proc/func
	63	*/
	64	switch (r[0]) {
65	case T_PROG:
66	if (opt('z'))
67	monflg++;
68	program = p = defnl(r[2], PROG, 0, 0);
69	p->value[3] = r[1];
70	break;
71	case T_PDEC:
72	if (r[4] != NIL)
73	error("Procedures do not have types, only functions do");
74	p = enter(defnl(r[2], PROC, 0, 0));
75	p->nl_flags =\| NMOD;
76	break;
77	case T_FDEC:
78	il = r[4];
79	if (il == NIL)
80	error("Function type must be specified");
81	else if (il[0] != T_TYID) {
82	il = NIL;
83	error("Function type can be specified only by using a type identifier");
84	} else
85	il = gtype(il);
86	p = enter(defnl(r[2], FUNC, il, NIL));
87	p->nl_flags =\| NMOD;
88	/*
89	* An arbitrary restriction
90	*/
91	switch (o = classify(p->type)) {
92	case TFILE:
93	case TARY:
94	case TREC:
95	case TSET:
96	case TSTR:
97	warning();
98	if (opt('s'))
99	standard();
100	error("Functions should not return %ss", clnames[o]);
101	}
102	break;
103	default:
104	panic("funchdr");
105	}
106	if (r[0] != T_PROG) {
107	/*
108	* Mark this proc/func as
109	* begin forward declared
110	*/
111	p->nl_flags =\| NFORWD;
112	/*
113	* Enter the parameters
114	* in the next block for
115	* the time being
116	*/
117	if (++cbn >= DSPLYSZ) {
118	error("Procedure/function nesting too deep");
119	pexit(ERRS);
120	}
121	/*
122	* For functions, the function variable
123	*/
124	if (p->class == FUNC) {
125	cp = defnl(r[2], FVAR, p->type, 0);
126	cp->chain = p;
127	p->value[NL_FVAR] = cp;
128	}
129	/*
130	* Enter the parameters
131	* and compute total size
132	*/
133	cp = sp = p;
134	o = 0;
135	for (rl = r[3]; rl != NIL; rl = rl[2]) {
136	p = NIL;
137	if (rl[1] == NIL)
138	continue;
139	/*
140	* Parametric procedures
141	* don't have types !?!
142	*/
143	if (rl[1][0] != T_PPROC) {
144	rll = rl[1][2];
145	if (rll[0] != T_TYID) {
146	error("Types for arguments can be specified only by using type identifiers");
147	p = NIL;
148	} else
149	p = gtype(rll);
150	}
151	for (il = rl[1][1]; il != NIL; il = il[2]) {
152	switch (rl[1][0]) {
153	default:
154	panic("funchdr2");
155	case T_PVAL:
156	if (p != NIL) {
157	if (p->class == FILE)
158	error("Files cannot be passed by value");
159	else if (p->nl_flags & NFILES)
160	error("Files cannot be a component of %ss passed by value",
161	nameof(p));
162	}
163	dp = defnl(il[1], VAR, p, o=- even(width(p)));
164	dp->nl_flags =\| NMOD;
165	break;
166	case T_PVAR:
167	dp = defnl(il[1], REF, p, o=- 2);
168	break;
169	case T_PFUNC:
170	case T_PPROC:
171	error("Procedure/function parameters not implemented");
172	continue;
173	}
174	if (dp != NIL) {
175	cp->chain = dp;
176	cp = dp;
177	}
178	}
179	}
180	cbn--;
181	p = sp;
182	p->value[NL_OFFS] = -o+DPOFF2;
183	/*
184	* Correct the naievity
185	* of our above code to
186	* calculate offsets
187	*/
188	for (il = p->chain; il != NIL; il = il->chain)
189	il->value[NL_OFFS] =+ p->value[NL_OFFS];
190	} else {
191	/*
192	* The wonderful
193	* program statement!
194	*/
195	if (monflg) {
196	cntpatch = put2(O_PXPBUF, 0);
197	nfppatch = put3(NIL, 0, 0);
198	}
199	cp = p;
200	for (rl = r[3]; rl; rl = rl[2]) {
201	if (rl[1] == NIL)
202	continue;
203	dp = defnl(rl[1], VAR, 0, 0);
204	cp->chain = dp;
205	cp = dp;
206	}
207	}
208	/*
209	* Define a branch at
210	* the "entry point" of
211	* the prog/proc/func.
212	*/
213	p->value[NL_LOC] = getlab();
214	if (monflg) {
215	put2(O_TRACNT, p->value[NL_LOC]);
216	putcnt();
217	} else
218	put2(O_TRA, p->value[NL_LOC]);
219	return (p);
220	}
221
222	funcfwd(fp)
223	struct nl *fp;
224	{
225
226	return (fp);
227	}
228
229	/*
230	* Funcbody is called
231	* when the actual (resolved)
232	* declaration of a procedure is
233	* encountered. It puts the names
234	* of the (function) and parameters
235	* into the symbol table.
236	*/
237	funcbody(fp)
238	struct nl *fp;
239	{
240	register struct nl q, p;
241
242	cbn++;
243	if (cbn >= DSPLYSZ) {
244	error("Too many levels of function/procedure nesting");
245	pexit(ERRS);
246	}
247	sizes[cbn].om_off = 0;
248	sizes[cbn].om_max = 0;
249	gotos[cbn] = NIL;
250	errcnt[cbn] = syneflg;
251	parts = NIL;
252	if (fp == NIL)
253	return (NIL);
254	/*
255	* Save the virtual name
256	* list stack pointer so
257	* the space can be freed
258	* later (funcend).
259	*/
260	fp->value[2] = nlp;
261	if (fp->class != PROG)
262	for (q = fp->chain; q != NIL; q = q->chain)
263	enter(q);
264	if (fp->class == FUNC) {
265	/*
266	* For functions, enter the fvar
267	*/
268	enter(fp->value[NL_FVAR]);
269	}
270	return (fp);
271	}
272
273	struct nl *Fp;
274	int pnumcnt;
275	/*
276	* Funcend is called to
277	* finish a block by generating
278	* the code for the statements.
279	* It then looks for unresolved declarations
280	* of labels, procedures and functions,
281	* and cleans up the name list.
282	* For the program, it checks the
283	* semantics of the program
284	* statement (yuchh).
285	*/
286	funcend(fp, bundle, endline)
287	struct nl *fp;
288	int *bundle;
289	int endline;
290	{
291	register struct nl *p;
292	register int i, b;
293	int var, inp, out, chkref, *blk;
294	struct nl *iop;
295	char *cp;
296	extern int cntstat;
297
298	cntstat = 0;
299	/*
300	yyoutline();
301	*/
302	if (program != NIL)
303	line = program->value[3];
304	blk = bundle[2];
305	if (fp == NIL) {
306	cbn--;
307	return;
308	}
309	/*
310	* Patch the branch to the
311	* entry point of the function
312	*/
313	patch(fp->value[NL_LOC]);
314	/*
315	* Put out the block entrance code and the block name.
316	* the CONG is overlaid by a patch later!
317	*/
318	var = put1(cbn == 1 && opt('p') == 0 ? O_NODUMP: O_BEG);
319	put3(O_CONG, 8, fp->symbol);
320	put2(NIL, bundle[1]);
321	if (fp->class == PROG) {
322	/*
323	* The glorious buffers option.
324	* 0 = don't buffer output
325	* 1 = line buffer output
326	* 2 = 512 byte buffer output
327	*/
328	if (opt('b') != 1)
329	put1(O_BUFF \| opt('b') << 8);
330	inp = 0;
331	out = 0;
332	for (p = fp->chain; p != NIL; p = p->chain) {
333	if (strcmp(p->symbol, "input") == 0) {
334	inp++;
335	continue;
336	}
337	if (strcmp(p->symbol, "output") == 0) {
338	out++;
339	continue;
340	}
341	iop = lookup1(p->symbol);
342	if (iop == NIL \|\| bn != cbn) {
343	error("File %s listed in program statement but not declared", p->symbol);
344	continue;
345	}
346	if (iop->class != VAR) {
347	error("File %s listed in program statement but declared as a %s", p->symbol, classes[iop->class]);
348	continue;
349	}
350	if (iop->type == NIL)
351	continue;
352	if (iop->type->class != FILE) {
353	error("File %s listed in program statement but defined as %s",
354	p->symbol, nameof(iop->type));
355	continue;
356	}
357	put2(O_LV \| bn << 9, iop->value[NL_OFFS]);
358	b = p->symbol;
359	while (b->pchar != '\0')
360	b++;
361	i = b - p->symbol;
362	put3(O_CONG, i, p->symbol);
363	put2(O_DEFNAME \| i << 8, text(iop->type) ? 0: width(iop->type->type));
364	}
365	if (out == 0 && fp->chain != NIL) {
366	recovered();
367	error("The file output must appear in the program statement file list");
368	}
369	}
370	/*
371	* Process the prog/proc/func body
372	*/
373	noreach = 0;
374	line = bundle[1];
375	statlist(blk);
376	if (cbn== 1 && monflg != 0) {
377	patchfil(cntpatch, cnts);
378	patchfil(nfppatch, pfcnt);
379	}
380	if (fp->class == PROG && inp == 0 && (input->nl_flags & (NUSED\|NMOD)) != 0) {
381	recovered();
382	error("Input is used but not defined in the program statement");
383	}
384	/*
385	* Clean up the symbol table displays and check for unresolves
386	*/
387	line = endline;
388	b = cbn;
389	Fp = fp;
390	chkref = syneflg == errcnt[cbn] && opt('w') == 0;
391	for (i = 0; i <= 077; i++) {
392	for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) {
393	/*
394	* Check for variables defined
395	* but not referenced
396	*/
397	if (chkref && p->symbol != NIL)
398	switch (p->class) {
399	case FIELD:
400	/*
401	* If the corresponding record is
402	* unused, we shouldn't complain about
403	* the fields.
404	*/
405	default:
406	if ((p->nl_flags & (NUSED\|NMOD)) == 0) {
407	warning();
408	nerror("%s %s is neither used nor set", classes[p->class], p->symbol);
409	break;
410	}
411	/*
412	* If a var parameter is either
413	* modified or used that is enough.
414	*/
415	if (p->class == REF)
416	continue;
417	if ((p->nl_flags & NUSED) == 0) {
418	warning();
419	nerror("%s %s is never used", classes[p->class], p->symbol);
420	break;
421	}
422	if ((p->nl_flags & NMOD) == 0) {
423	warning();
424	nerror("%s %s is used but never set", classes[p->class], p->symbol);
425	break;
426	}
427	case LABEL:
428	case FVAR:
429	case BADUSE:
430	break;
431	}
432	switch (p->class) {
433	case BADUSE:
434	cp = "s";
435	if (p->chain->ud_next == NIL)
436	cp++;
437	eholdnl();
438	if (p->value[NL_KINDS] & ISUNDEF)
439	nerror("%s undefined on line%s", p->symbol, cp);
440	else
441	nerror("%s improperly used on line%s", p->symbol, cp);
442	pnumcnt = 10;
443	pnums(p->chain);
444	putchar('\n');
445	break;
446
447	case FUNC:
448	case PROC:
449	if (p->nl_flags & NFORWD)
450	nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol);
451	break;
452
453	case LABEL:
454	if (p->nl_flags & NFORWD)
455	nerror("label %s was declared but not defined", p->symbol);
456	break;
457	case FVAR:
458	if ((p->nl_flags & NMOD) == 0)
459	nerror("No assignment to the function variable");
460	break;
461	}
462	}
463	/*
464	* Pop this symbol
465	* table slot
466	*/
467	disptab[i] = p;
468	}
469
470	put1(O_END);
471	#ifdef DEBUG
472	dumpnl(fp->value[2], fp->symbol);
473	#endif
474	/*
475	* Restore the
476	* (virtual) name list
477	* position
478	*/
479	nlfree(fp->value[2]);
480	/*
481	* Proc/func has been
482	* resolved
483	*/
484	fp->nl_flags =& ~NFORWD;
485	/*
486	* Patch the beg
487	* of the proc/func to
488	* the proper variable size
489	*/
490	i = sizes[cbn].om_max;
491	if (sizes[cbn].om_max < -50000.)
492	nerror("Storage requirement of %ld bytes exceeds hardware capacity", -sizes[cbn].om_max);
493	if (Fp == NIL)
494	elineon();
495	patchfil(var, i);
496	cbn--;
497	if (inpflist(fp->symbol)) {
498	opop('l');
499	}
500	}
501
502	pnums(p)
503	struct udinfo *p;
504	{
505
506	if (p->ud_next != NIL)
507	pnums(p->ud_next);
508	if (pnumcnt == 0) {
509	printf("\n\t");
510	pnumcnt = 20;
511	}
512	pnumcnt--;
513	printf(" %d", p->ud_line);
514	}
515
516	nerror(a1, a2, a3)
517	{
518
519	if (Fp != NIL) {
520	yySsync();
521	#ifndef PI1
522	if (opt('l'))
523	yyoutline();
524	#endif
525	yysetfile(filename);
526	printf("In %s %s:\n", classes[Fp->class], Fp->symbol);
527	Fp = NIL;
528	elineoff();
529	}
530	error(a1, a2, a3);
531	}