[unix-history] / src / pi1 / stat.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"

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;
#ifdef DEBUG
	int limitrv = (hp21mx ? O_RV2 : O_RV4) | cbn << 9;
	int limitsz = (hp21mx ? 2 : 4);
#endif

	p = NIL;
	goc = gocnt;
	if (r == NIL)
		goto aloha;
	putline();
	/*
	 * Allocate automatic
	 * space for limit variable
	 */
#ifndef DEBUG
	sizes[cbn].om_off =- 4;
#else
	sizes[cbn].om_off =- limitsz;
#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);
#ifndef DEBUG
	put1(width(t2) <= 2 ? O_AS24 : O_AS4);
#else
	if (hp21mx)
		put1(O_AS2);
	else
		put1(width(t2) <= 2 ? O_AS24 : O_AS4);
#endif
	/*
	 * 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;
	}
	if (incompat(t2, t1, r[3])) {
		cerror("Limit type clashed with index type in 'for' statement");
		statement(r[4]);
		goto aloha;
	}
	/*
	 * See if we can skip the loop altogether
	 */
	rr = r[2];
	if (rr != NIL)
		rvalue(rr[2], NIL);
#ifndef DEBUG
	put2(O_RV4 | cbn<<9, i);
	gen(NIL, r[0] == T_FORU ? T_LE : T_GE, width(t1), 4);
#else
	put1(limitrv, i);
	gen(NIL, r[0] == T_FORU ? T_LE : T_GE, width(t1), limitsz);
#endif
	/*
	 * 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
		 */
#ifndef DEBUG
		put2(O_RV4 | cbn<<9, i);
#else
		put2(limitrv, i);
#endif
		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);
#ifndef DEBUG
		put2(O_RV4 | cbn << 9, i);
		gen(NIL, (r[0] == T_FORU ? T_LT : T_GT), width(t1), 4);
#else
		put2(limitrv, i);
		gen(NIL, (r[0] == T_FORU ? T_LT : T_GT), width(t1), limitsz);
#endif
		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);
	}
#ifdef DEBUG
	sizes[cbn].om_off =+ limitsz;
#else
	sizes[cbn].om_off =+ 4;
#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(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
16494185 BJ	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
	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	#ifdef DEBUG
301	int limitrv = (hp21mx ? O_RV2 : O_RV4) \| cbn << 9;
302	int limitsz = (hp21mx ? 2 : 4);
303	#endif
304
305	p = NIL;
306	goc = gocnt;
307	if (r == NIL)
308	goto aloha;
309	putline();
310	/*
311	* Allocate automatic
312	* space for limit variable
313	*/
314	#ifndef DEBUG
315	sizes[cbn].om_off =- 4;
316	#else
317	sizes[cbn].om_off =- limitsz;
318	#endif
319	if (sizes[cbn].om_off < sizes[cbn].om_max)
320	sizes[cbn].om_max = sizes[cbn].om_off;
321	i = sizes[cbn].om_off;
322	/*
323	* Initialize the limit variable
324	*/
325	put2(O_LV \| cbn<<9, i);
326	t2 = rvalue(r[3], NIL);
327	#ifndef DEBUG
328	put1(width(t2) <= 2 ? O_AS24 : O_AS4);
329	#else
330	if (hp21mx)
331	put1(O_AS2);
332	else
333	put1(width(t2) <= 2 ? O_AS24 : O_AS4);
334	#endif
335	/*
336	* Assignment of initial value to for variable
337	*/
338	t1 = asgnop1(r[2], NIL);
339	if (t1 == NIL) {
340	rvalue(r[3], NIL);
341	statement(r[4]);
342	goto aloha;
343	}
344	rr = r[2]; /* Assignment */
345	rr = rr[2]; /* Lhs variable */
346	if (rr[3] != NIL) {
347	error("For variable must be unqualified");
348	rvalue(r[3], NIL);
349	statement(r[4]);
350	goto aloha;
351	}
352	p = lookup(rr[2]);
353	p->value[NL_FORV] = 1;
354	if (isnta(t1, "bcis")) {
355	error("For variables cannot be %ss", nameof(t1));
356	statement(r[4]);
357	goto aloha;
358	}
359	if (incompat(t2, t1, r[3])) {
360	cerror("Limit type clashed with index type in 'for' statement");
361	statement(r[4]);
362	goto aloha;
363	}
364	/*
365	* See if we can skip the loop altogether
366	*/
367	rr = r[2];
368	if (rr != NIL)
369	rvalue(rr[2], NIL);
370	#ifndef DEBUG
371	put2(O_RV4 \| cbn<<9, i);
372	gen(NIL, r[0] == T_FORU ? T_LE : T_GE, width(t1), 4);
373	#else
374	put1(limitrv, i);
375	gen(NIL, r[0] == T_FORU ? T_LE : T_GE, width(t1), limitsz);
376	#endif
377	/*
378	* L1 will be patched to skip the body of the loop.
379	* L2 marks the top of the loop when we go around.
380	*/
381	put2(O_IF, (l1 = getlab()));
382	putlab(l2 = getlab());
383	putcnt();
384	statement(r[4]);
385	/*
386	* now we see if we get to go again
387	*/
388	if (opt('t') == 0) {
389	/*
390	* Easy if we dont have to test
391	*/
392	#ifndef DEBUG
393	put2(O_RV4 \| cbn<<9, i);
394	#else
395	put2(limitrv, i);
396	#endif
397	if (rr != NIL)
398	lvalue(rr[2], MOD);
399	put2((r[0] == T_FORU ? O_FOR1U : O_FOR1D) + (width(t1) >> 1), l2);
400	} else {
401	line = r[1];
402	putline();
403	if (rr != NIL)
404	rvalue(rr[2], NIL);
405	#ifndef DEBUG
406	put2(O_RV4 \| cbn << 9, i);
407	gen(NIL, (r[0] == T_FORU ? T_LT : T_GT), width(t1), 4);
408	#else
409	put2(limitrv, i);
410	gen(NIL, (r[0] == T_FORU ? T_LT : T_GT), width(t1), limitsz);
411	#endif
412	l3 = put2(O_IF, getlab());
413	lvalue(rr[2], MOD);
414	rvalue(rr[2], NIL);
415	put2(O_CON2, 1);
416	t2 = gen(NIL, r[0] == T_FORU ? T_ADD: T_SUB, width(t1), 2);
417	rangechk(t1, t2); /* The point of all this */
418	gen(O_AS2, O_AS2, width(t1), width(t2));
419	put2(O_TRA, l2);
420	patch(l3);
421	}
422	#ifdef DEBUG
423	sizes[cbn].om_off =+ limitsz;
424	#else
425	sizes[cbn].om_off =+ 4;
426	#endif
427	patch(l1);
428	aloha:
429	noreach = 0;
430	if (p != NIL)
431	p->value[NL_FORV] = 0;
432	if (goc != gocnt)
433	putcnt();
434	}
435
436	/*
437	* if expr then stat [ else stat ]
438	*/
439	ifop(r)
440	int *r;
441	{
442	register struct nl *p;
443	register l1, l2;
444	int nr, goc;
445
446	goc = gocnt;
447	if (r == NIL)
448	return;
449	putline();
450	p = rvalue(r[2], NIL);
451	if (p == NIL) {
452	statement(r[3]);
453	noreach = 0;
454	statement(r[4]);
455	noreach = 0;
456	return;
457	}
458	if (isnta(p, "b")) {
459	error("Type of expression in if statement must be Boolean, not %s", nameof(p));
460	statement(r[3]);
461	noreach = 0;
462	statement(r[4]);
463	noreach = 0;
464	return;
465	}
466	l1 = put2(O_IF, getlab());
467	putcnt();
468	statement(r[3]);
469	nr = noreach;
470	if (r[4] != NIL) {
471	/*
472	* else stat
473	*/
474	--level;
475	ungoto();
476	++level;
477	l2 = put2(O_TRA, getlab());
478	patch(l1);
479	noreach = 0;
480	statement(r[4]);
481	noreach =& nr;
482	l1 = l2;
483	} else
484	noreach = 0;
485	patch(l1);
486	if (goc != gocnt)
487	putcnt();
488	}
489
490	/*
491	* while expr do stat
492	*/
493	whilop(r)
494	int *r;
495	{
496	register struct nl *p;
497	register l1, l2;
498	int goc;
499
500	goc = gocnt;
501	if (r == NIL)
502	return;
503	putlab(l1 = getlab());
504	putline();
505	p = rvalue(r[2], NIL);
506	if (p == NIL) {
507	statement(r[3]);
508	noreach = 0;
509	return;
510	}
511	if (isnta(p, "b")) {
512	error("Type of expression in while statement must be Boolean, not %s", nameof(p));
513	statement(r[3]);
514	noreach = 0;
515	return;
516	}
517	put2(O_IF, (l2 = getlab()));
518	putcnt();
519	statement(r[3]);
520	put2(O_TRA, l1);
521	patch(l2);
522	if (goc != gocnt)
523	putcnt();
524	}
525
526	/*
527	* repeat stat* until expr
528	*/
529	repop(r)
530	int *r;
531	{
532	register struct nl *p;
533	register l;
534	int goc;
535
536	goc = gocnt;
537	if (r == NIL)
538	return;
539	l = putlab(getlab());
540	putcnt();
541	statlist(r[2]);
542	line = r[1];
543	p = rvalue(r[3], NIL);
544	if (p == NIL)
545	return;
546	if (isnta(p,"b")) {
547	error("Until expression type must be Boolean, not %s, in repeat statement", nameof(p));
548	return;
549	}
550	put2(O_IF, l);
551	if (goc != gocnt)
552	putcnt();
553	}
554
555	/*
556	* assert expr
557	*/
558	asrtop(r)
559	register int *r;
560	{
561	register struct nl *q;
562
563	if (opt('s')) {
564	standard();
565	error("Assert statement is non-standard");
566	}
567	if (!opt('t'))
568	return;
569	r = r[2];
570	q = rvalue(r, NIL);
571	if (q == NIL)
572	return;
573	if (isnta(q, "b"))
574	error("Assert expression must be Boolean, not %ss", nameof(q));
575	put1(O_ASRT);
576	}