USG_PG3/usr/source/lil/str.c

#include "common"

/*
	ref(p)->value = truth value of condition
	p->prev = top of former local region
	p->tbran, fbran -> created symbols for conditional jump targets
	p->start, sbias = elc at top of loop
*/

doarg(p1, p2) struct at *p1, *p2;
	{extern int stackoff;
	if (skip) return;
	if (atime)
		{if (test(p1, DEFF) ||
			test(p1->value = localize((p1->value)->name,
			p1->flags & ATTR, MEM, 0, p1->size), DEFF) ||
			(p1->value)->value)
			{error("illegal declaration %s", s(p1));
			p1->value = NULL; }
		else if (p2) (p1->value)->value = p2->value;
		 }
	else {
		if (p2 == NULL && lookup(NULL, ".temp")->value)
			{geninst(byte(p1, NULL) + 0010016, p1, NULL);
			setvb(p1, 0, 0); }
		else {
			geninst(byte(p1, NULL) + 0010046, p1, NULL);
			setvb(p1, p2 ? p2->value + 1 : 1, 0);
			stackoff =+ 2;
			}
		}
	 }

endcall(p1, p2) struct at *p1, *p2;
	{extern int stackoff;
	int v;
	struct at *p, *q, *r;
	if (skip) return;
	if (atime)
		{set(p1, DCLF, TRUE);
		if (p2 == NULL) p1->size = 0;
		else {
			r = ref(p1);
			setvb(p1, r->value, r->bias);
			v = p1->value;
			for (p = p2->value; p; p = q)
				{q = p->value; p->value = 0;
				define(p, p1->flags & ATTR | DCLF, p1->type,
					v, p1->bias);
				if (p1->type == REG || p1->type == IREG)
					v = (v + p->size / 2)
						% 8;
				else v =+ p->size; }
			p1->size = v - p1->value;
			p1->value = v;
			if (1 <= p1->bias && p1->bias <= 3)
				{v = elc;
				setelc(p1->value, p1->bias);
				setelc(v->value, v->bias); }
			}
		 }
	else {
		endlocal(p1->prev);
		if (p1->type == LABEL) p1->type = p1->bias;
		geninst(004700, NULL, p1);		/* jsr pc,~ */
		if (p2) {switch (p2->value) {
	 case 0:	break;
	 case 1:	gen(005726, 0); break;		/* tst (sp)+ */
	 case 2:	gen(022626, 0); break;		/* cmp (sp)+,(sp)+ */
	 default:	gen(062706, 0);			/* add ~,sp */
			gen(2 * p2->value, 0);
						}
			stackoff =- 2 * p2->value;
			}
		ref(p1)->size = 0;
		p1->size = 2;
		set(p1, PUBF | BCCF, TRUE);
		p1->type = REG;
		setvb(p1, 0, 0);
		 }
	 }

dodecl(p1, p2) struct at *p1, *p2;
	{struct at *p, *q;
	if (skip) return;
	for (p = p2->value; p; p = q)
		{q = p->value; p->value = 0;
		if (p1->type == LOCAL)
			localize(p->name, p1->flags & ATTR | DCLF,
				MEM, 0, p1->size);
		else set(p, PUBF, TRUE);
		}
	}

dolabel(p1) struct at *p1;
	{if (skip) return;
	if (!atime)
		{p1->prev = spsave; spsave = sptop;
		if (!test(p1, DEFF))
			{p1->bias = p1->type;
			p1->type = LABEL; }
		}
	}

endlabel(p1) struct at *p1;
	{if (skip) return;
	endlocal(p1->prev);
	if (p1->type == LABEL)
		{define(p1->value, 0, MEM, p1->start, p1->sbias);
		(p1->value)->size = elc->value - p1->start; }
	else error("illegal label %s", s(p1));
	p1->type = ERR;
	}

endlocal(ps) struct symbol *ps;
	{struct symbol *p, *q;
	p = sptop; sptop = spsave;
	for ( ; p != spsave; p = q) {
		q = p->prev;
		if (!test(p, DEFF))
			{if (test(p, DCLF))
				error("undefined - %s", sn(p->name));
			else {p->prev = sptop; sptop = p; }
			 }
		if (debug > 1) error("%c%c %s %o+%o",
			test(p, DEFF) ? 'd' : ' ',
			test(p, DCLF) ? 'l' : ' ',
			sn(p->name), p->value, p->bias);
					}
	spsave = ps; }

begloop(p1, p2) struct at *p1, *p2;
	{if (skip) return;
	if (p1) p2->fbran = linkup(p2->fbran, p1->fbran);
	p2->type = DO;
	begthen(p2);
	}

begthen(p1) struct at *p1;
	{int k;
	if (skip) return;
	k = ref(p1)->value;
	if (k == FALSE && p1->tbran == NULL ||
		k == TRUE && p1->fbran == NULL)
		{endthen(p1);
		skip = !k;
		set(p1, SKPF, TRUE);
		setvb(p1, k, 0);
		if (debug && skip) error("skipping"); }
	else switch (next()) {
 case GOTO:
 case BREAK:	setvb(p1, FALSE, 0); setvb(&e, k, 0);
		e.tbran = p1->tbran; e.fbran = p1->fbran;
		p1->tbran = p1->fbran = NULL;
		break;

 case SCOLON:	break;

 default:	setvb(p1, TRUE, 0);
		p1->fbran = fjump(k ^ 1, p1->fbran, NULL);
		target(&(p1->tbran));
				}
	 }

endthen(p1) struct at *p1;
	{if (test(p1, SKPF))
		{skip = FALSE;
		if (debug) error("end skip"); }
	else {target(&(p1->tbran)); target(&(p1->fbran)); }
	 }

begelse(p1) struct at *p1;
	{int k;
	if (test(p1, SKPF))
		{set(p1, SKPF, skip = !skip);
		if (debug) error(skip ? "skipping" : "end skip"); }
	else	{k = ref(p1)->value;
		switch (next()) {
	 case GOTO:
	 case BREAK:	e.tbran = p1->fbran; e.fbran = p1->tbran;
			p1->tbran = p1->fbran = NULL;
			setvb(&e, k ^ 1, e.bias);
			break;

	 case SCOLON:	break;

	 default:	p1->tbran = fjump(k, p1->tbran, NULL);
			target(&(p1->fbran));
					}
		}
	 }

endloop(p1) struct at *p1;
	{if (skip) return;
	if (p1->tbran)
		{define(p1->tbran, 0, MEM, p1->start, p1->sbias);
		p1->tbran = NULL; }
	jump(ref(p1)->value, p1->start, p1->sbias);
	p1->type = ERR;
	}

begbreak(p1, p2) struct at *p1, *p2;
	{extern struct token stack[];
	struct token *p;
	int k;
	if (skip) return;
	k = ref(p1)->value;
	if (p2 == NULL || !test(p2, DEFF))
		{for (p = p1; p != stack; --p)
			if (p2 == NULL && (p->type == DO || p->type == LABEL)
				|| p2 && p->type == LABEL &&
				compare((p->value)->name, (p2->value)->name))
				{if (test(p1, BYTF))
					{if (p1->tbran) define(p1->tbran, 0,
						MEM, p->start, p->sbias);
					jump(k, p->start, p->sbias); }
				else p->fbran = fjump(k, p->fbran, p1->tbran);
				p1->tbran = NULL;
				endthen(p1);
				return; }
		}
	error("illegal break");
	}

begkbin(p1, p2) struct at *p1, *p2;
	{int k, op;
	if (skip) return;
	k = ref(p1)->value; op = ref(p2)->value;
	p1->type = ERR;
	if (atime) {
		if (k != TRUE && k != FALSE)
			error("illegal compile-time conditional %s %s",
				s(p1), s(p2));
		else if (k && op == OR || !k && op == AND)
			set(p1, SKPF, TRUE);
			}
	else {
		if (op == OR)
			{p1->tbran = fjump(k, p1->tbran, NULL);
			target(&(p1->fbran)); }
		else {
			p1->fbran = fjump(k ^ 1, p1->fbran, NULL);
			target(&(p1->tbran)); }
		}
	 }

endkbin(p1, p2) struct at *p1, *p2;
	{if (skip) return;
	if (!(atime && test(p1, SKPF))) setvb(p1, ref(p2)->value, 0);
	p1->tbran = linkup(p1->tbran, p2->tbran);
	p1->fbran = linkup(p1->fbran, p2->fbran);
	set(p1, SKPF, FALSE); }

dogoto(p1, p2) struct at *p1, *p2;
	{int k;
	struct at *p;
	if (skip) return;
	k = ref(p1)->value;
	p = ref(p2);
	if (test(p, DEFF) && p2->type == MEM) fjump(k, p, p1->tbran);
	else {
		k = (k ^ 1) << 8;
		switch (p2->type & ~R) {
	 case MIDX:
	 case IMIDX:
	 case CON:
	 case ICON:
	 case MEM:
	 case IMEM:	if (k) gen(k + 2, 0); break;	/* br over jmp */
	
	 default:	if (k) gen(k + 1, 0); break; }
		settoelc(p1->tbran);
		geninst(000100, NULL, p2);	/* jmp */
		}
	target(&(p1->fbran)); }