[unix-history] / usr / src / cmd / pi / stat.c

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

#include "whoami"
#include "0.h"
#include "tree.h"

int cntstat;
short cnts = 2;
#include "opcode.h"

/*
 * Statement list
 */
statlist(r)
	int *r;
{
	register *sl;

	for (sl=r; sl != NIL; sl=sl[2])
		statement(sl[1]);
}

/*
 * Statement
 */
statement(r)
	int *r;
{
	register *s;
	register struct nl *snlp;

	s = r;
	snlp = nlp;
top:
	if (cntstat) {
		cntstat = 0;
		putcnt();
	}
	if (s == NIL)
		return;
	line = s[1];
	if (s[0] == T_LABEL) {
		labeled(s[2]);
		s = s[3];
		noreach = 0;
		cntstat = 1;
		goto top;
	}
	if (noreach) {
		noreach = 0;
		warning();
		error("Unreachable statement");
	}
	switch (s[0]) {
		case T_PCALL:
			putline();
			proc(s);
			break;
		case T_ASGN:
			putline();
			asgnop(s);
			break;
		case T_GOTO:
			putline();
			gotoop(s[2]);
			noreach = 1;
			cntstat = 1;
			break;
		default:
			level++;
			switch (s[0]) {
				default:
					panic("stat");
				case T_IF:
				case T_IFEL:
					ifop(s);
					break;
				case T_WHILE:
					whilop(s);
					noreach = 0;
					break;
				case T_REPEAT:
					repop(s);
					break;
				case T_FORU:
				case T_FORD:
					forop(s);
					noreach = 0;
					break;
				case T_BLOCK:
					statlist(s[2]);
					break;
				case T_CASE:
					putline();
					caseop(s);
					break;
				case T_WITH:
					withop(s);
					break;
				case T_ASRT:
					putline();
					asrtop(s);
					break;
			}
			--level;
			if (gotos[cbn])
				ungoto();
			break;
	}
	/*
	 * Free the temporary name list entries defined in
	 * expressions, e.g. STRs, and WITHPTRs from withs.
	 */
	nlfree(snlp);
}

ungoto()
{
	register struct nl *p;

	for (p = gotos[cbn]; p != NIL; p = p->chain)
		if ((p->nl_flags & NFORWD) != 0) {
			if (p->value[NL_GOLEV] != NOTYET)
				if (p->value[NL_GOLEV] > level)
					p->value[NL_GOLEV] = level;
		} else
			if (p->value[NL_GOLEV] != DEAD)
				if (p->value[NL_GOLEV] > level)
					p->value[NL_GOLEV] = DEAD;
}

putcnt()
{

	if (monflg == 0)
		return;
	cnts++;
	put2(O_COUNT, cnts);
}

putline()
{

#	ifdef OBJ
	    if (opt('p') != 0)
		    put2(O_LINO, line);
#	endif
}

/*
 * With varlist do stat
 *
 * With statement requires an extra word
 * in automatic storage for each level of withing.
 * These indirect pointers are initialized here, and
 * the scoping effect of the with statement occurs
 * because lookup examines the field names of the records
 * associated with the WITHPTRs on the withlist.
 */
withop(s)
	int *s;
{
	register *p;
	register struct nl *r;
	int i;
	int *swl;
	long soffset;

	putline();
	swl = withlist;
	soffset = sizes[cbn].om_off;
	for (p = s[2]; p != NIL; p = p[2]) {
		sizes[cbn].om_off -= sizeof ( int * );
#		ifdef PPC
		    putlbracket();
#		endif
		put2(O_LV | cbn <<9, i = sizes[cbn].om_off);
		r = lvalue(p[1], MOD);
		if (r == NIL)
			continue;
		if (r->class != RECORD) {
			error("Variable in with statement refers to %s, not to a record", nameof(r));
			continue;
		}
		r = defnl(0, WITHPTR, r, i);
		r->nl_next = withlist;
		withlist = r;
#		ifdef	VAX
		    put1 ( O_AS4 );
#		endif
#		ifdef PDP11
		    put1(O_AS2);
#		endif
	}
	if (sizes[cbn].om_off < sizes[cbn].om_max)
		sizes[cbn].om_max = sizes[cbn].om_off;
	statement(s[3]);
	sizes[cbn].om_off = soffset;
#	ifdef PPC
	    putlbracket();
#	endif
	withlist = swl;
}

extern	flagwas;
/*
 * var := expr
 */
asgnop(r)
	int *r;
{
	register struct nl *p;
	register *av;

	if (r == NIL)
		return (NIL);
	/*
	 * Asgnop's only function is
	 * to handle function variable
	 * assignments.  All other assignment
	 * stuff is handled by asgnop1.
	 */
	av = r[2];
	if (av != NIL && av[0] == T_VAR && av[3] == NIL) {
		p = lookup1(av[2]);
		if (p != NIL)
			p->nl_flags = flagwas;
		if (p != NIL && p->class == FVAR) {
			/*
			 * Give asgnop1 the func
			 * which is the chain of
			 * the FVAR.
			 */
			p->nl_flags |= NUSED|NMOD;
			p = p->chain;
			if (p == NIL) {
				rvalue(r[3], NIL);
				return;
			}
			put2(O_LV | bn << 9, p->value[NL_OFFS]);
			if (isa(p->type, "i") && width(p->type) == 1)
				asgnop1(r, nl+T2INT);
			else
				asgnop1(r, p->type);
			return;
		}
	}
	asgnop1(r, NIL);
}

/*
 * Asgnop1 handles all assignments.
 * If p is not nil then we are assigning
 * to a function variable, otherwise
 * we look the variable up ourselves.
 */
struct nl *
asgnop1(r, p)
	int *r;
	register struct nl *p;
{
	register struct nl *p1;

	if (r == NIL)
		return (NIL);
	if (p == NIL) {
		p = lvalue(r[2], MOD|ASGN|NOUSE);
		if (p == NIL) {
			rvalue(r[3], NIL);
			return (NIL);
		}
	}
	p1 = rvalue(r[3], p);
	if (p1 == NIL)
		return (NIL);
	if (incompat(p1, p, r[3])) {
		cerror("Type of expression clashed with type of variable in assignment");
		return (NIL);
	}
	switch (classify(p)) {
		case TBOOL:
		case TCHAR:
		case TINT:
		case TSCAL:
			rangechk(p, p1);
		case TDOUBLE:
		case TPTR:
			gen(O_AS2, O_AS2, width(p), width(p1));
			break;
		default:
			put2(O_AS, width(p));
	}
#	ifdef PPC
	    putexpr();
#	endif
	return (p);	/* Used by for statement */
}

/*
 * for var := expr [down]to expr do stat
 */
forop(r)
	int *r;
{
	register struct nl *t1, *t2;
	int l1, l2, l3;
	long soffset;
	register op;
	struct nl *p;
	int *rr, goc, i;

	p = NIL;
	goc = gocnt;
	if (r == NIL)
		goto aloha;
	putline();
	/*
	 * Start with assignment
	 * of initial value to for variable
	 */
	t1 = asgnop1(r[2], NIL);
	if (t1 == NIL) {
		rvalue(r[3], NIL);
		statement(r[4]);
		goto aloha;
	}
	rr = r[2];		/* Assignment */
	rr = rr[2];		/* Lhs variable */
	if (rr[3] != NIL) {
		error("For variable must be unqualified");
		rvalue(r[3], NIL);
		statement(r[4]);
		goto aloha;
	}
	p = lookup(rr[2]);
	p->value[NL_FORV] = 1;
	if (isnta(t1, "bcis")) {
		error("For variables cannot be %ss", nameof(t1));
		statement(r[4]);
		goto aloha;
	}
	/*
	 * Allocate automatic
	 * space for limit variable
	 */
	sizes[cbn].om_off -= 4;
#	ifdef PPC
	    putlbracket();
#	endif
	if (sizes[cbn].om_off < sizes[cbn].om_max)
		sizes[cbn].om_max = sizes[cbn].om_off;
	i = sizes[cbn].om_off;
	/*
	 * Initialize the limit variable
	 */
	put2(O_LV | cbn<<9, i);
	t2 = rvalue(r[3], NIL);
	if (incompat(t2, t1, r[3])) {
		cerror("Limit type clashed with index type in 'for' statement");
		statement(r[4]);
		goto aloha;
	}
	put1(width(t2) <= 2 ? O_AS24 : O_AS4);
#	ifdef PPC
	    putexpr();
#	endif
	/*
	 * See if we can skip the loop altogether
	 */
	rr = r[2];
	if (rr != NIL)
		rvalue(rr[2], NIL);
	put2(O_RV4 | cbn<<9, i);
	gen(NIL, r[0] == T_FORU ? T_LE : T_GE, width(t1), 4);
	/*
	 * L1 will be patched to skip the body of the loop.
	 * L2 marks the top of the loop when we go around.
	 */
	put2(O_IF, (l1 = getlab()));
	putlab(l2 = getlab());
	putcnt();
	statement(r[4]);
	/*
	 * now we see if we get to go again
	 */
	if (opt('t') == 0) {
		/*
		 * Easy if we dont have to test
		 */
		put2(O_RV4 | cbn<<9, i);
		if (rr != NIL)
			lvalue(rr[2], MOD);
		put2((r[0] == T_FORU ? O_FOR1U : O_FOR1D) + (width(t1) >> 1), l2);
	} else {
		line = r[1];
		putline();
		if (rr != NIL)
			rvalue(rr[2], NIL);
		put2(O_RV4 | cbn << 9, i);
		gen(NIL, (r[0] == T_FORU ? T_LT : T_GT), width(t1), 4);
		l3 = put2(O_IF, getlab());
		lvalue((int *) rr[2], MOD);
		rvalue(rr[2], NIL);
		put2(O_CON2, 1);
		t2 = gen(NIL, r[0] == T_FORU ? T_ADD: T_SUB, width(t1), 2);
		rangechk(t1, t2);	/* The point of all this */
		gen(O_AS2, O_AS2, width(t1), width(t2));
		put2(O_TRA, l2);
		patch(l3);
	}
	sizes[cbn].om_off += 4;
#	ifdef PPC
	    putlbracket();
#	endif
	patch(l1);
aloha:
	noreach = 0;
	if (p != NIL)
		p->value[NL_FORV] = 0;
	if (goc != gocnt)
		putcnt();
}

/*
 * if expr then stat [ else stat ]
 */
ifop(r)
	int *r;
{
	register struct nl *p;
	register l1, l2;
	int nr, goc;

	goc = gocnt;
	if (r == NIL)
		return;
	putline();
	p = rvalue(r[2], NIL);
	if (p == NIL) {
		statement(r[3]);
		noreach = 0;
		statement(r[4]);
		noreach = 0;
		return;
	}
	if (isnta(p, "b")) {
		error("Type of expression in if statement must be Boolean, not %s", nameof(p));
		statement(r[3]);
		noreach = 0;
		statement(r[4]);
		noreach = 0;
		return;
	}
	l1 = put2(O_IF, getlab());
	putcnt();
	statement(r[3]);
	nr = noreach;
	if (r[4] != NIL) {
		/*
		 * else stat
		 */
		--level;
		ungoto();
		++level;
		l2 = put2(O_TRA, getlab());
		patch(l1);
		noreach = 0;
		statement(r[4]);
		noreach &= nr;
		l1 = l2;
	} else
		noreach = 0;
	patch(l1);
	if (goc != gocnt)
		putcnt();
}

/*
 * while expr do stat
 */
whilop(r)
	int *r;
{
	register struct nl *p;
	register l1, l2;
	int goc;

	goc = gocnt;
	if (r == NIL)
		return;
	putlab(l1 = getlab());
	putline();
	p = rvalue(r[2], NIL);
	if (p == NIL) {
		statement(r[3]);
		noreach = 0;
		return;
	}
	if (isnta(p, "b")) {
		error("Type of expression in while statement must be Boolean, not %s", nameof(p));
		statement(r[3]);
		noreach = 0;
		return;
	}
	put2(O_IF, (l2 = getlab()));
	putcnt();
	statement(r[3]);
	put2(O_TRA, l1);
	patch(l2);
	if (goc != gocnt)
		putcnt();
}

/*
 * repeat stat* until expr
 */
repop(r)
	int *r;
{
	register struct nl *p;
	register l;
	int goc;

	goc = gocnt;
	if (r == NIL)
		return;
	l = putlab(getlab());
	putcnt();
	statlist(r[2]);
	line = r[1];
	p = rvalue(r[3], NIL);
	if (p == NIL)
		return;
	if (isnta(p,"b")) {
		error("Until expression type must be Boolean, not %s, in repeat statement", nameof(p));
		return;
	}
	put2(O_IF, l);
	if (goc != gocnt)
		putcnt();
}

/*
 * assert expr
 */
asrtop(r)
	register int *r;
{
	register struct nl *q;

	if (opt('s')) {
		standard();
		error("Assert statement is non-standard");
	}
	if (!opt('t'))
		return;
	r = r[2];
	q = rvalue((int *) r, NLNIL);
	if (q == NIL)
		return;
	if (isnta(q, "b"))
		error("Assert expression must be Boolean, not %ss", nameof(q));
	put1(O_ASRT);
}
Commit	Line	Data
6172cbb3 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 November 1978
	8	*/
	9
	10	#include "whoami"
	11	#include "0.h"
	12	#include "tree.h"
	13
	14	int cntstat;
	15	short cnts = 2;
	16	#include "opcode.h"
	17
	18	/*
	19	* Statement list
	20	*/
	21	statlist(r)
	22	int *r;
	23	{
	24	register *sl;
	25
	26	for (sl=r; sl != NIL; sl=sl[2])
	27	statement(sl[1]);
	28	}
	29
	30	/*
	31	* Statement
	32	*/
	33	statement(r)
	34	int *r;
	35	{
	36	register *s;
	37	register struct nl *snlp;
	38
	39	s = r;
	40	snlp = nlp;
	41	top:
	42	if (cntstat) {
	43	cntstat = 0;
	44	putcnt();
	45	}
	46	if (s == NIL)
	47	return;
	48	line = s[1];
	49	if (s[0] == T_LABEL) {
	50	labeled(s[2]);
	51	s = s[3];
	52	noreach = 0;
	53	cntstat = 1;
	54	goto top;
	55	}
	56	if (noreach) {
	57	noreach = 0;
	58	warning();
	59	error("Unreachable statement");
	60	}
	61	switch (s[0]) {
	62	case T_PCALL:
	63	putline();
	64	proc(s);
65	break;
66	case T_ASGN:
67	putline();
68	asgnop(s);
69	break;
70	case T_GOTO:
71	putline();
72	gotoop(s[2]);
73	noreach = 1;
74	cntstat = 1;
75	break;
76	default:
77	level++;
78	switch (s[0]) {
79	default:
80	panic("stat");
81	case T_IF:
82	case T_IFEL:
83	ifop(s);
84	break;
85	case T_WHILE:
86	whilop(s);
87	noreach = 0;
88	break;
89	case T_REPEAT:
90	repop(s);
91	break;
92	case T_FORU:
93	case T_FORD:
94	forop(s);
95	noreach = 0;
96	break;
97	case T_BLOCK:
98	statlist(s[2]);
99	break;
100	case T_CASE:
101	putline();
102	caseop(s);
103	break;
104	case T_WITH:
105	withop(s);
106	break;
107	case T_ASRT:
108	putline();
109	asrtop(s);
110	break;
111	}
112	--level;
113	if (gotos[cbn])
114	ungoto();
115	break;
116	}
117	/*
118	* Free the temporary name list entries defined in
119	* expressions, e.g. STRs, and WITHPTRs from withs.
120	*/
121	nlfree(snlp);
122	}
123
124	ungoto()
125	{
126	register struct nl *p;
127
128	for (p = gotos[cbn]; p != NIL; p = p->chain)
129	if ((p->nl_flags & NFORWD) != 0) {
130	if (p->value[NL_GOLEV] != NOTYET)
131	if (p->value[NL_GOLEV] > level)
132	p->value[NL_GOLEV] = level;
133	} else
134	if (p->value[NL_GOLEV] != DEAD)
135	if (p->value[NL_GOLEV] > level)
136	p->value[NL_GOLEV] = DEAD;
137	}
138
139	putcnt()
140	{
141
142	if (monflg == 0)
143	return;
144	cnts++;
145	put2(O_COUNT, cnts);
146	}
147
148	putline()
149	{
150
151	# ifdef OBJ
152	if (opt('p') != 0)
153	put2(O_LINO, line);
154	# endif
155	}
156
157	/*
158	* With varlist do stat
159	*
160	* With statement requires an extra word
161	* in automatic storage for each level of withing.
162	* These indirect pointers are initialized here, and
163	* the scoping effect of the with statement occurs
164	* because lookup examines the field names of the records
165	* associated with the WITHPTRs on the withlist.
166	*/
167	withop(s)
168	int *s;
169	{
170	register *p;
171	register struct nl *r;
172	int i;
173	int *swl;
174	long soffset;
175
176	putline();
177	swl = withlist;
178	soffset = sizes[cbn].om_off;
179	for (p = s[2]; p != NIL; p = p[2]) {
180	sizes[cbn].om_off -= sizeof ( int * );
181	# ifdef PPC
182	putlbracket();
183	# endif
184	put2(O_LV \| cbn <<9, i = sizes[cbn].om_off);
185	r = lvalue(p[1], MOD);
186	if (r == NIL)
187	continue;
188	if (r->class != RECORD) {
189	error("Variable in with statement refers to %s, not to a record", nameof(r));
190	continue;
191	}
192	r = defnl(0, WITHPTR, r, i);
193	r->nl_next = withlist;
194	withlist = r;
195	# ifdef VAX
196	put1 ( O_AS4 );
197	# endif
198	# ifdef PDP11
199	put1(O_AS2);
200	# endif
201	}
202	if (sizes[cbn].om_off < sizes[cbn].om_max)
203	sizes[cbn].om_max = sizes[cbn].om_off;
204	statement(s[3]);
205	sizes[cbn].om_off = soffset;
206	# ifdef PPC
207	putlbracket();
208	# endif
209	withlist = swl;
210	}
211
212	extern flagwas;
213	/*
214	* var := expr
215	*/
216	asgnop(r)
217	int *r;
218	{
219	register struct nl *p;
220	register *av;
221
222	if (r == NIL)
223	return (NIL);
224	/*
225	* Asgnop's only function is
226	* to handle function variable
227	* assignments. All other assignment
228	* stuff is handled by asgnop1.
229	*/
230	av = r[2];
231	if (av != NIL && av[0] == T_VAR && av[3] == NIL) {
232	p = lookup1(av[2]);
233	if (p != NIL)
234	p->nl_flags = flagwas;
235	if (p != NIL && p->class == FVAR) {
236	/*
237	* Give asgnop1 the func
238	* which is the chain of
239	* the FVAR.
240	*/
241	p->nl_flags \|= NUSED\|NMOD;
242	p = p->chain;
243	if (p == NIL) {
244	rvalue(r[3], NIL);
245	return;
246	}
247	put2(O_LV \| bn << 9, p->value[NL_OFFS]);
248	if (isa(p->type, "i") && width(p->type) == 1)
249	asgnop1(r, nl+T2INT);
250	else
251	asgnop1(r, p->type);
252	return;
253	}
254	}
255	asgnop1(r, NIL);
256	}
257
258	/*
259	* Asgnop1 handles all assignments.
260	* If p is not nil then we are assigning
261	* to a function variable, otherwise
262	* we look the variable up ourselves.
263	*/
264	struct nl *
265	asgnop1(r, p)
266	int *r;
267	register struct nl *p;
268	{
269	register struct nl *p1;
270
271	if (r == NIL)
272	return (NIL);
273	if (p == NIL) {
274	p = lvalue(r[2], MOD\|ASGN\|NOUSE);
275	if (p == NIL) {
276	rvalue(r[3], NIL);
277	return (NIL);
278	}
279	}
280	p1 = rvalue(r[3], p);
281	if (p1 == NIL)
282	return (NIL);
283	if (incompat(p1, p, r[3])) {
284	cerror("Type of expression clashed with type of variable in assignment");
285	return (NIL);
286	}
287	switch (classify(p)) {
288	case TBOOL:
289	case TCHAR:
290	case TINT:
291	case TSCAL:
292	rangechk(p, p1);
293	case TDOUBLE:
294	case TPTR:
295	gen(O_AS2, O_AS2, width(p), width(p1));
296	break;
297	default:
298	put2(O_AS, width(p));
299	}
300	# ifdef PPC
301	putexpr();
302	# endif
303	return (p); /* Used by for statement */
304	}
305
306	/*
307	* for var := expr [down]to expr do stat
308	*/
309	forop(r)
310	int *r;
311	{
312	register struct nl t1, t2;
313	int l1, l2, l3;
314	long soffset;
315	register op;
316	struct nl *p;
317	int *rr, goc, i;
318
319	p = NIL;
320	goc = gocnt;
321	if (r == NIL)
322	goto aloha;
323	putline();
324	/*
325	* Start with assignment
326	* of initial value to for variable
327	*/
328	t1 = asgnop1(r[2], NIL);
329	if (t1 == NIL) {
330	rvalue(r[3], NIL);
331	statement(r[4]);
332	goto aloha;
333	}
334	rr = r[2]; /* Assignment */
335	rr = rr[2]; /* Lhs variable */
336	if (rr[3] != NIL) {
337	error("For variable must be unqualified");
338	rvalue(r[3], NIL);
339	statement(r[4]);
340	goto aloha;
341	}
342	p = lookup(rr[2]);
343	p->value[NL_FORV] = 1;
344	if (isnta(t1, "bcis")) {
345	error("For variables cannot be %ss", nameof(t1));
346	statement(r[4]);
347	goto aloha;
348	}
349	/*
350	* Allocate automatic
351	* space for limit variable
352	*/
353	sizes[cbn].om_off -= 4;
354	# ifdef PPC
355	putlbracket();
356	# endif
357	if (sizes[cbn].om_off < sizes[cbn].om_max)
358	sizes[cbn].om_max = sizes[cbn].om_off;
359	i = sizes[cbn].om_off;
360	/*
361	* Initialize the limit variable
362	*/
363	put2(O_LV \| cbn<<9, i);
364	t2 = rvalue(r[3], NIL);
365	if (incompat(t2, t1, r[3])) {
366	cerror("Limit type clashed with index type in 'for' statement");
367	statement(r[4]);
368	goto aloha;
369	}
370	put1(width(t2) <= 2 ? O_AS24 : O_AS4);
371	# ifdef PPC
372	putexpr();
373	# endif
374	/*
375	* See if we can skip the loop altogether
376	*/
377	rr = r[2];
378	if (rr != NIL)
379	rvalue(rr[2], NIL);
380	put2(O_RV4 \| cbn<<9, i);
381	gen(NIL, r[0] == T_FORU ? T_LE : T_GE, width(t1), 4);
382	/*
383	* L1 will be patched to skip the body of the loop.
384	* L2 marks the top of the loop when we go around.
385	*/
386	put2(O_IF, (l1 = getlab()));
387	putlab(l2 = getlab());
388	putcnt();
389	statement(r[4]);
390	/*
391	* now we see if we get to go again
392	*/
393	if (opt('t') == 0) {
394	/*
395	* Easy if we dont have to test
396	*/
397	put2(O_RV4 \| cbn<<9, i);
398	if (rr != NIL)
399	lvalue(rr[2], MOD);
400	put2((r[0] == T_FORU ? O_FOR1U : O_FOR1D) + (width(t1) >> 1), l2);
401	} else {
402	line = r[1];
403	putline();
404	if (rr != NIL)
405	rvalue(rr[2], NIL);
406	put2(O_RV4 \| cbn << 9, i);
407	gen(NIL, (r[0] == T_FORU ? T_LT : T_GT), width(t1), 4);
408	l3 = put2(O_IF, getlab());
409	lvalue((int *) rr[2], MOD);
410	rvalue(rr[2], NIL);
411	put2(O_CON2, 1);
412	t2 = gen(NIL, r[0] == T_FORU ? T_ADD: T_SUB, width(t1), 2);
413	rangechk(t1, t2); /* The point of all this */
414	gen(O_AS2, O_AS2, width(t1), width(t2));
415	put2(O_TRA, l2);
416	patch(l3);
417	}
418	sizes[cbn].om_off += 4;
419	# ifdef PPC
420	putlbracket();
421	# endif
422	patch(l1);
423	aloha:
424	noreach = 0;
425	if (p != NIL)
426	p->value[NL_FORV] = 0;
427	if (goc != gocnt)
428	putcnt();
429	}
430
431	/*
432	* if expr then stat [ else stat ]
433	*/
434	ifop(r)
435	int *r;
436	{
437	register struct nl *p;
438	register l1, l2;
439	int nr, goc;
440
441	goc = gocnt;
442	if (r == NIL)
443	return;
444	putline();
445	p = rvalue(r[2], NIL);
446	if (p == NIL) {
447	statement(r[3]);
448	noreach = 0;
449	statement(r[4]);
450	noreach = 0;
451	return;
452	}
453	if (isnta(p, "b")) {
454	error("Type of expression in if statement must be Boolean, not %s", nameof(p));
455	statement(r[3]);
456	noreach = 0;
457	statement(r[4]);
458	noreach = 0;
459	return;
460	}
461	l1 = put2(O_IF, getlab());
462	putcnt();
463	statement(r[3]);
464	nr = noreach;
465	if (r[4] != NIL) {
466	/*
467	* else stat
468	*/
469	--level;
470	ungoto();
471	++level;
472	l2 = put2(O_TRA, getlab());
473	patch(l1);
474	noreach = 0;
475	statement(r[4]);
476	noreach &= nr;
477	l1 = l2;
478	} else
479	noreach = 0;
480	patch(l1);
481	if (goc != gocnt)
482	putcnt();
483	}
484
485	/*
486	* while expr do stat
487	*/
488	whilop(r)
489	int *r;
490	{
491	register struct nl *p;
492	register l1, l2;
493	int goc;
494
495	goc = gocnt;
496	if (r == NIL)
497	return;
498	putlab(l1 = getlab());
499	putline();
500	p = rvalue(r[2], NIL);
501	if (p == NIL) {
502	statement(r[3]);
503	noreach = 0;
504	return;
505	}
506	if (isnta(p, "b")) {
507	error("Type of expression in while statement must be Boolean, not %s", nameof(p));
508	statement(r[3]);
509	noreach = 0;
510	return;
511	}
512	put2(O_IF, (l2 = getlab()));
513	putcnt();
514	statement(r[3]);
515	put2(O_TRA, l1);
516	patch(l2);
517	if (goc != gocnt)
518	putcnt();
519	}
520
521	/*
522	* repeat stat* until expr
523	*/
524	repop(r)
525	int *r;
526	{
527	register struct nl *p;
528	register l;
529	int goc;
530
531	goc = gocnt;
532	if (r == NIL)
533	return;
534	l = putlab(getlab());
535	putcnt();
536	statlist(r[2]);
537	line = r[1];
538	p = rvalue(r[3], NIL);
539	if (p == NIL)
540	return;
541	if (isnta(p,"b")) {
542	error("Until expression type must be Boolean, not %s, in repeat statement", nameof(p));
543	return;
544	}
545	put2(O_IF, l);
546	if (goc != gocnt)
547	putcnt();
548	}
549
550	/*
551	* assert expr
552	*/
553	asrtop(r)
554	register int *r;
555	{
556	register struct nl *q;
557
558	if (opt('s')) {
559	standard();
560	error("Assert statement is non-standard");
561	}
562	if (!opt('t'))
563	return;
564	r = r[2];
565	q = rvalue((int *) r, NLNIL);
566	if (q == NIL)
567	return;
568	if (isnta(q, "b"))
569	error("Assert expression must be Boolean, not %ss", nameof(q));
570	put1(O_ASRT);
571	}