USG_PG3/usr/source/lil/sem.c

#include "common"

test(p1, f) struct at *p1; int f; {return ((p1->flags & f) != 0); }

set(p1, f1, f2) struct at *p1; int f1, f2;
	{if (f2) p1->flags =| f1;
	else p1->flags =& ~f1; }

struct at *ref(p1) struct at *p1;
	{if (test(p1, DEFF)) return (p1);
	return (p1->value); }

struct at *reg(p1) struct at *p1;
	{if (p1->type == REG) return (ref(p1));
	return (NULL); }

struct at *con(p1) struct at *p1;
	{int p;
	return (p1->type == CON && test(p = ref(p1), DEFF) &&
		p->bias == 0 ? p : NULL); }

setvb(p1, v, b) struct at *p1; int v, b;
	{p1->value = v; p1->bias = b;
	set(p1, DEFF, TRUE); }

define(p1, f, t, v, b) struct symbol *p1; int f, t, v, b;
	{int bp;
	do {
		if (test(p1, DEFF) && p1 != dot)
			{error("illegal redefinition of %s", sn(p1->name));
			return; }
		if (debug) error("%o+%o = %o+%o %s", p1->value, p1->bias,
			v, b, sn(p1->name));
		bp = p1->bias;
		p1->flags =| f; p1->type = t;
		setvb(p1, v, b);
		if (p1 == dot || p1 == &symtab[bp]) break;
		p1 = &symtab[bp];
		} while (TRUE);
	}

settoelc(p1) struct at *p1;
	{if (p1) define(p1, 0, MEM, elc->value, elc->bias); }

struct symbol *localize(n, f, t, v, z) char n[]; int f, t, v, z;
	{struct symbol *p;
	if ((p = lookup(spsave, n)) == NULL) p = add(n, f, t, v, z);
	else {p->flags =| f; p->size = z; }
	return (p); }

et()	{if (dot->bias != elc->bias || dot->value > elc->value)
		setelc(dot->value, dot->bias);
	else settoelc(dot); }

dopop(p1) struct at *p1; {
	if (skip) return;
	if (p1->type == IREG) p1->type = RINC;
	else error("%s++ illegal", s(p1)); }

index(p1, p2) struct at *p1, *p2;
	{struct at *p, *q;
	if (skip) return;
	if ((p = reg(p2)) && !test(p2, ATTR) &&
		(p1->type == CON || p1->type == MEM))
		p1->type = MIDX + p->value;
	else if ((p = con(p2)) && p1->type == MEM)
		{q = ref(p1);
		setvb(p1, q->value + p->value * q->size, q->bias); }
	else error("%s[%s] illegal", s(p1), s(p2)); }

indir(p1) struct at *p1;
	{if (skip) return;
	if (!test(p1, ATTR))
		switch (p1->type & ~R) {
 case REG:
 case RDEC:
 case RINC:
 case MIDX:
 case CON:
 case MEM:	p1->type =+ I; return;

 case IREG:	p1->type = IMIDX + (ref(p1)->value & R);
		setvb(p1, 0, 0); return;
					}
	error("[%s] illegal", s(p1)); }

begatime(p1) struct at *p1;
	{if (skip) return;
	atime =+ 1;
	setvb(p1, dot->value, dot->bias); }

endatime(p1, p2) struct at *p1, *p2;
	{if (skip) return;
	atime =- 1;
	set(p2, PUBF | SKPF, FALSE);
	}

endexp(p1) struct at *p1;
	{struct at *p;
	if (skip) return;
	if (test(p1, PUBF | DCLF)) return;
	p = ref(p1);
	if (p1->type == CON || p1->type == MEM)
		gen(p->value, p->bias);
	else error("illegal constant %s", s(p1)); }

makond(p1) struct at *p1;
	{setvb(p1, ref(p1)->value, 0);
	p1->type = KOND; }

knot(p1, p2) struct at *p1, *p2;
	{int p;
	if (skip) return;
	if (ref(p1)->value != NOT)
		error("%s %s illegal", s(p1), s(p2));
	else {
		setvb(p2, ref(p2)->value ^ 1, p2->bias);
		p = p2->fbran; p2->fbran = p2->tbran; p2->tbran = p; }
	}

alloc(p1, p2) struct at *p1, *p2;
	{struct at *p;
	int v;
	if (skip) return;
	if (ref(p1)->value != GETS)
		error("%s STRING illegal", s(p1));
	else {
		p = elc;
		setelc(symtab[2].value, 2);
		v = elc->value;
		if (dostring(p2) & 0177400) gen(0, 0);
		setelc(p->value, p->bias);
		p2->type = CON;
		setvb(p2, v, 2); }
	}

unop(p1, p2) struct at *p1, *p2;
	{struct at *p, *ps;
	int op, v;
	if (skip) return;
	p = ref(p2);
	set(p2, DCLF | PUBF, FALSE);
	switch (op = ref(p1)->value) {
 case NOP:	return;

 case PUSH:	if (p2->type != IREG) break;
		p2->type = RDEC; return;

 case GETS:	if (con(p2) == NULL || p->bias) break;
		ps = elc;
		setelc(symtab[2].value, 2);
		v = elc->value;
		gen(p->value, 0);
		if (p->value & 0177400) gen(0, 0);
		setelc(ps->value, ps->bias);
		p2->type = CON;
		setvb(p2, v, 2);
		return;

 case AND:
 case MEMOP:	set(p2, ATTR, FALSE);
		p2->type = op == AND ? CON : MEM; return;
 case REGOP:	if (!test(p, DEFF) || p->bias ||
			p->value < 0 || 7 < p->value) break;
		set(p2, ATTR, FALSE);
		p2->type = REG; return;

 case WORD:
 case BYTE:	set(p2, ATTR, FALSE);
		set(p2, BYTF, op == BYTE);
		return;

 case MINUS:
 case NOT:	if (con(p2))
			setvb(p2, op == MINUS ? -p->value : ~p->value, 0);
		else if (p2->type == KOND && op == NOT)
			setvb(p2, p->value ^ 1, p2->bias);
		else break;
		return;

 case SIZE:	setvb(p2, p->size, 0);
		p2->type = CON;
		return;

 case RTS:
 case JSR:	if (reg(p2) == NULL) break;
		p2->type = CON;
		setvb(p2, op == RTS ? 000200 + p->value
			: 004037 + (p->value << 6), 0);
		return;

 case SYS:	if (con(p2) == NULL) break;
		setvb(p2, 0104400 + p->value, 0); return;

			}
	error("%s %s illegal", s(p1), s(p2));
	}

compat(p1, p2) struct at *p1, *p2;
	{return ((p1->flags & ATTR) == (p2->flags & ATTR)
		|| (p1->type == REG || p1->type == CON) && !test(p1, BYTF)
		|| (p2->type == REG || p2->type == CON) && !test(p2, BYTF)
		?1:0); }

byte(p1, p2) struct at *p1, *p2;
	{return((p1 ? test(p1, BYTF) : FALSE) ||
		(p2 ? test(p2, BYTF) : FALSE)
		? 0100000 : 0); }

rexp(p1) struct at *p1;
	{struct at op, pr;
	if (p1->type == KOND) return;
	op.flags = DEFF; op.value = NE;
	pr.type = CON;
	pr.flags = DEFF; pr.value = pr.bias = 0;
	rop(p1, &op, &pr); copy(&op); }

rop(p1, p2, p3) struct at *p1, *p2, *p3;
	{struct at *pl, *pr;
	int op;
	if (skip) return;
	pl = ref(p1);
	op = ref(p2)->value;
	pr = ref(p3);
	p2->type = KOND;
	if (atime) {
		if (pl->bias != pr->bias)
			{error("%s %s %s illegal at compile time",
				s(p1), s(p2), s(p3));
			return; }
		switch (op) {
	 case GE:	op = pl->value >= pr->value; break;
	 case GT:	op = pl->value >  pr->value; break;
	 case NE:	op = pl->value != pr->value; break;
	 case EQ:	op = pl->value == pr->value; break;
	 case LT:	op = pl->value <  pr->value; break;
	 case LE:	op = pl->value <= pr->value; break;

	 default:	error("%s %s %s illegal at compile time",
				s(p1), s(p2), s(p3));
			op = FALSE;
						}
		setvb(p2, op, 0); }
	else {
		if (!compat(p1, p3))
			error("%s %s %s illegal", s(p1), s(p2), s(p3));
		else if (con(p3) && pr->value == 0)
			{if (test(p1, PUBF) && !test(p1, BCCF)) ;
			else geninst(byte(p1, NULL) + 005700, NULL, p1); }
		else if (con(p1) && pl->value == 0)
			{geninst(byte(p3, NULL) + 005700, NULL, p3);
			if (op != EQ && op != NE) setvb(p2, op ^ 1, 0); }
		else geninst(byte(p1, p3) + 020000, p1, p3);
		}
	}