#include "sno.h" /* * sno4 */ and(ptr) struct node *ptr; { register struct node *a, *p; p = ptr; a = p->p1; if (p->typ == 0) { switch (a->typ) { case0: case 0: a->typ = 1; case 1: goto l1; case 3: flush(); return(syspit()); case 5: a = a->p2->p1; goto l1; case 6: return(binstr(nfree())); } writes("attempt to take an illegal value"); goto case0; l1: a = copy(a->p2); } return(a); } eval(e, t) struct node *e; { struct node *list, *a2, *a3, *a4, *a3base; register struct node *a1, *stack, *op; if (rfail == 1) return(0); stack = 0; list = e; goto l1; advanc: list = list->p1; l1: op = list->typ; switch (op) { default: case 0: if (t == 1) { a1 = and(stack); goto e1; } if (stack->typ == 1) writes("attempt to store in a value"); a1 = stack->p1; e1: stack = pop(stack); if (stack) writes("phase error"); return(a1); case 12: a1 = and(stack); stack->p1 = look(a1); delete(a1); stack->typ = 0; goto advanc; case 13: if (stack->typ) writes("illegal function"); a1 = stack->p1; if (a1->typ!=5) writes("illegal function"); a1 = a1->p2; op = a1->p1; a3base = a3 = alloc(); a3->p2 = op->p2; op->p2 = 0; a1 = a1->p2; a2 = list->p2; f1: if (a1!=0 & a2!=0) goto f2; if (a1!=a2) writes("parameters do not match"); op = op->p1; goto f3; f2: a3->p1 = a4 = alloc(); a3 = a4; a3->p2 = and(a1); assign(a1->p1, eval(a2->p2, 1));/* recursive */ a1 = a1->p2; a2 = a2->p1; goto f1; f3: op = execute(op); /* recursive */ if (op) goto f3; a1 = stack->p1->p2; op = a1->p1; a3 = a3base; stack->p1 = op->p2; stack->typ = 1; op->p2 = a3->p2; f4: a4 = a3->p1; free(a3); a3 = a4; a1 = a1->p2; if (a1 == 0) goto advanc; assign(a1->p1, a3->p2); goto f4; case 11: case 10: case 9: case 8: case 7: a1 = and(stack); stack = pop(stack); a2 = and(stack); a3 = doop(op, a2, a1); delete(a1); delete(a2); stack->p1 = a3; stack->typ = 1; goto advanc; case 15: a1 = copy(list->p2); a2 = 1; goto l3; case 14: a1 = list->p2; a2 = 0; l3: stack = push(stack); stack->p1 = a1; stack->typ = a2; goto advanc; } } doop(op, arg1, arg2) { register int a1, a2; a1 = arg1; a2 = arg2; switch (op) { case 11: return(div(a1, a2)); case 10: return(mult(a1, a2)); case 8: return(add(a1, a2)); case 9: return(sub(a1, a2)); case 7: return(cat(a1, a2)); } return(0); } execute(e) struct node *e; { register struct node *r, *b, *c; struct node *m, *ca, *d, *a; r = e->p2; lc = e->ch; switch (e->typ) { case 0: /* r g */ a = r->p1; delete(eval(r->p2, 1)); goto xsuc; case 1: /* r m g */ m = r->p1; a = m->p1; b = eval(r->p2, 1); c = search(m, b); delete(b); if (c == 0) goto xfail; free(c); goto xsuc; case 2: /* r a g */ ca = r->p1; a = ca->p1; b = eval(r->p2, 0); assign(b, eval(ca->p2, 1)); goto xsuc; case 3: /* r m a g */ m = r->p1; ca = m->p1; a = ca->p1; b = eval(r->p2, 0); d = search(m, b->p2); if (d == 0) goto xfail; c = eval(ca->p2, 1); if (d->p1 == 0) { free(d); assign(b, cat(c, b->p2)); delete(c); goto xsuc; } if (d->p2 == b->p2->p2) { assign(b, c); free(d); goto xsuc; } (r=alloc())->p1 = d->p2->p1; r->p2 = b->p2->p2; assign(b, cat(c, r)); free(d); free(r); delete(c); goto xsuc; } xsuc: if (rfail) goto xfail; b = a->p1; goto xboth; xfail: rfail = 0; b = a->p2; xboth: if (b == 0) { return(e->p1); } b = eval(b, 0); if (b == lookret) return(0); if (b == lookfret) { rfail = 1; return(0); } if (b->typ!=2) writes("attempt to transfer to non-label"); return(b->p2); } assign(adr, val) struct node *adr, *val; { register struct node *a, *addr, *value; addr = adr; value = val; if (rfail == 1) { delete(value); return; } switch (addr->typ) { default: writes("attempt to make an illegal assignment"); case 0: addr->typ = 1; case 1: delete(addr->p2); addr->p2 = value; return; case 4: sysput(value); return; case 5: a = addr->p2->p1; delete(a->p2); a->p2 = value; return; } }