Interdata_v6/usr/source/sno/sno2.c

#include "sno.h"


compon() {
	register struct node *a, *b;
	register int c;
	static next;

	if (next == 0)
		schar = agetc(); else
		next = 0;
	if (schar == 0) {
		(a=alloc())->typ = 0;
		return(a);
	}
	switch (class(schar->ch)) {

	case 1:
		schar->typ = 5;
		return(schar);

	case 2:
		schar->typ = 16;
		return(schar);

	case 3:
		a = schar;
		for(;;) {
			schar = agetc();
			if (schar == 0) {
				a->typ = 0;
				return(a);
			}
			if (class(schar->ch) != 3)
				break;
			free(schar);
		}
		next = 1;
		a->typ = 7;
		return(a);

	case 4:
		schar->typ = 8;
		return(schar);

	case 5:
		schar->typ = 9;
		return(schar);

	case 6:
		a = schar;
		schar = agetc();
		if (class(schar->ch) == 3)
			a->typ = 10; else
			a->typ = 1;
		next = 1;
		return(a);

	case 7:
		a = schar;
		schar = agetc();
		if (class(schar->ch) == 3)
			a->typ = 11; else
			a->typ = 2;
		next = 1;
		return(a);

	case 8:
		schar->typ = 12;
		return(schar);

	case 9:
		c = schar->ch;
		a = agetc();
		if(a == 0)
			goto lerr;
		b = schar;
		if(a->ch == c) {
			free(schar);
			a->typ = 15;
			a->p1 = 0;
			return(a);
		}
		b->p1 = a;
		for(;;) {
			schar = agetc();
			if (schar == 0)
			lerr:
				writes("illegal literal string");
			if(schar->ch == c)
				break;
			a->p1 = schar;
			a = schar;
		}
		b->p2 = a;
		schar->typ = 15;
		schar->p1 = b;
		return(schar);

	case 10:
		schar->typ = 3;
		return(schar);

	case 11:
		schar->typ = 4;
		return(schar);

	}
	b = alloc();
	b->p1 = a = schar;
	schar = agetc();
	while(schar!=0 & !class(schar->ch)) {
		a->p1 = schar;
		a = schar;
		schar = agetc();
	}
	b->p2 = a;
	next = 1;
	a = look(b);
	delete(b);
	b = alloc();
	b->typ = 14;
	b->p1 = a;
	return(b);
}

nscomp()
{
	register struct node *c;

	while((c=compon())->typ == 7)
		free(c);
	return(c);
}

push(stack) {
	register struct node *a;

	(a=alloc())->p2 = stack;
	return(a);
}

pop(stack)
struct node *stack;
{
	register struct node *a, *s;

	s = stack;
	if (s == 0)
		writes("pop");
	a = s->p2;
	free(s);
	return(a);
}

expr(start, eof, e)
struct node *e;
{
	register struct node *stack, *list, *comp;
	int operand, op, space, op1;
	struct node *a, *b, *c;
	int d;

	list = alloc();
	e->p2 = list;
	stack = push(0);
	stack->typ = eof;
	operand = 0;
	space = start;
l1:
	if (space) {
		comp = space;
		space = 0;
	} else
		comp = compon();

l3:
	op = comp->typ;
	switch (op) {

	case 7:
		space = 1;
		free(comp);
		comp = compon();
		goto l3;

	case 10:
		if (space == 0) {
			comp->typ = 1;
			goto l3;
		}

	case 11:
		if (space == 0) {
			comp->typ = 2;
			goto l3;
		}

	case 8:
	case 9:
		if (operand == 0)
			writes("no operand preceding operator");
		operand = 0;
		goto l5;

	case 14:
	case 15:
		if (operand == 0) {
			operand = 1;
			goto l5;
		}
		if (space == 0)
			goto l7;
		goto l4;

	case 12:
		if (operand == 0)
			goto l5;
		if (space)
			goto l4;
	l7:
		writes("illegal juxtaposition of operands");

	case 16:
		if (operand == 0)
			goto l5;
		if (space)
			goto l4;
		b = compon();
		op = comp->typ = 13;
		if (b->typ == 5) {
			comp->p1 = 0;
			goto l10;
		}
		comp->p1 = a = alloc();
		b = expr(b, 6, a);
		while((d=b->typ) == 4) {
			a->p1 = b;
			a = b;
			b = expr(0, 6, a);
		}
		if (d != 5)
			writes("error in function");
		a->p1 = 0;
	l10:
		free(b);
		goto l6;

	l4:
		space = comp;
		op = 7;
		operand = 0;
		goto l6;
	}
	if (operand==0)
		writes("no operand at end of expression");
l5:
	space = 0;
l6:
	op1 = stack->typ;
	if (op > op1) {
		stack = push(stack);
		if (op == 16)
			op = 6;
		stack->typ = op;
		stack->p1 = comp;
		goto l1;
	}
	c = stack->p1;
	stack = pop(stack);
	if (stack == 0) {
		list->typ = 0;
		return(comp);
	}
	if (op1 == 6) {
		if (op != 5)
			writes("too many ('s");
		goto l1;
	}
	if (op1 == 7)
		c = alloc();
	list->typ = op1;
	list->p2 = c->p1;
	list->p1 = c;
	list = c;
	goto l6;
}

match(start, m)
struct node *m;
{
	register struct node *list, *comp, *term;
	struct node *a;
	int b, bal;

	term = bal = 0;
	list = alloc();
	m->p2 = list;
	comp = start;
	if (!comp)
		comp = compon();
	goto l2;

l3:
	list->p1 = a = alloc();
	list = a;
l2:
	switch (comp->typ) {
	case 7:
		free(comp);
		comp = compon();
		goto l2;

	case 12:
	case 14:
	case 15:
	case 16:
		term = 0;
		comp = expr(comp, 6, list);
		list->typ = 1;
		goto l3;

	case 1:
		free(comp);
		comp = compon();
		bal = 0;
		if (comp->typ == 16) {
			bal = 1;
			free(comp);
			comp = compon();
		}
		a = alloc();
		b = comp->typ;
		if (b == 2 | b == 5 | b == 10 | b == 1)
			a->p1 = 0; else {
			comp = expr(comp, 11, a);
			a->p1 = a->p2;
		}
		if (comp->typ != 2) {
			a->p2 = 0;
		} else {
			free(comp);
			comp = expr(0, 6, a);
		}
		if (bal) {
			if (comp->typ != 5)
				goto merr;
			free(comp);
			comp = compon();
		}
		b = comp->typ;
		if (b != 1 & b != 10)
			goto merr;
		list->p2 = a;
		list->typ = 2;
		a->typ = bal;
		free(comp);
		comp = compon();
		if(bal)
			term = 0; else
			term = list;
		goto l3;
	}
	if(term)
		term->typ = 3;
	list->typ = 0;
	return(comp);

merr:
	writes("unrecognized component in match");
}

compile() {
	register struct node *b, *comp;
	struct node *r, *l, *xs, *xf, *g;
	register int a;
	int m, t, as;

	m = l = as = xs = xf = t = 0;
	comp = compon();
	a = comp->typ;
	if (a == 14) {
		l = comp->p1;
		free(comp);
		comp = compon();
		a = comp->typ;
	}
	if (a != 7)
		writes("no space beginning statement");
	free(comp);
	if (l == lookdef)
		goto def;
	comp = expr(0, 11, r=alloc());
	a = comp->typ;
	if (a == 0)
		goto asmble;
	if (a == 2)
		goto xfer;
	if (a == 3)
		goto assig;
	m = alloc();
	comp = match(comp, m);
	a = comp->typ;
	if (a == 0)
		goto asmble;
	if (a == 2)
		goto xfer;
	if (a == 3)
		goto assig;
	writes("unrecognized component in match");

assig:
	free(comp);
	comp = expr(0, 6, as=alloc());
	a = comp->typ;
	if (a == 0)
		goto asmble;
	if (a == 2)
		goto xfer;
	writes("unrecognized component in assignment");

xfer:
	free(comp);
	comp = compon();
	a = comp->typ;
	if (a == 16)
		goto xboth;
	if (a == 0) {
		if (xs!=0 | xf!=0)
			goto asmble;
		goto xerr;
	}
	if (a != 14)
		goto xerr;
	b = comp->p1;
	free(comp);
	if (b == looks)
		goto xsuc;
	if (b == lookf)
		goto xfail;

xerr:
	writes("unrecognized component in goto");

xboth:
	free(comp);
	xs = alloc();
	xf = alloc();
	comp = expr(0, 6, xs);
	if (comp->typ != 5)
		goto xerr;
	xf->p2 = xs->p2;
	comp = compon();
	if (comp->typ != 0)
		goto xerr;
	goto asmble;

xsuc:
	if(xs)
		goto xerr;
	comp = compon();
	if (comp->typ != 16)
		goto xerr;
	comp = expr(0, 6, xs=alloc());
	if (comp->typ != 5)
		goto xerr;
	goto xfer;

xfail:
	if (xf)
		goto xerr;
	comp = compon();
	if (comp->typ != 16)
		goto xerr;
	comp = expr(0, 6, xf=alloc());
	if (comp->typ != 5)
		goto xerr;
	goto xfer;

asmble:
	if(l) {
		if (l->typ)
			writes("name doubly defined");
		l->p2 = comp;
		l->typ = 2; /* type label;*/
	}
	comp->p2 = r;
	if (m) {
		t++;
		r->p1 = m;
		r = m;
	}
	if (as) {
		t =+ 2;
		r->p1 = as;
		r = as;
	}
	(g=alloc())->p1 = 0;
	if (xs) {
		g->p1 = xs->p2;
		free(xs);
	}
	g->p2 = 0;
	if (xf) {
		g->p2 = xf->p2;
		free(xf);
	}
	r->p1 = g;
	comp->typ = t;
	comp->ch = lc;
	return(comp);

def:
	r = nscomp();
	if (r->typ != 14)
		goto derr;
	l = r->p1;
	if (l->typ)
		writes("name doubly defined");
	l->typ = 5; /*type function;*/
	a = r;
	l->p2 = a;
	r = nscomp();
	l = r;
	a->p1 = l;
	if (r->typ == 0)
		goto d4;
	if (r->typ != 16)
		goto derr;

d2:
	r = nscomp();
	if (r->typ != 14)
		goto derr;
	a->p2 = r;
	r->typ = 0;
	a = r;
	r = nscomp();
	if (r->typ == 4) {
		free(r);
		goto d2;
	}
	if (r->typ != 5)
		goto derr;
	free(r);
	if ((r=compon())->typ != 0)
		goto derr;
	free(r);

d4:
	r = compile();
	a->p2 = 0;
	l->p1 = r;
	l->p2 = 0;
	return(r);

derr:
	writes("illegal component in define");
}