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

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

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

int cntstat;
int 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()
{

	if (opt('p') != 0)
		put2(O_LINO, line);
}

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