home *** CD-ROM | disk | FTP | other *** search
/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Trees / V6 / usr / source / sno / sno4.c < prev   
Encoding:
C/C++ Source or Header  |  1975-05-13  |  4.1 KB  |  283 lines

  1. #include "sno.h"
  2. /*
  3.  * sno4
  4.  */
  5.  
  6.  
  7. and(ptr)
  8. struct node *ptr;
  9. {
  10.     register struct node *a, *p;
  11.  
  12.     p = ptr;
  13.     a = p->p1;
  14.     if (p->typ == 0) {
  15.         switch (a->typ) {
  16.         case0:
  17.         case 0:
  18.             a->typ = 1;
  19.         case 1:
  20.             goto l1;
  21.         case 3:
  22.             flush();
  23.             return(syspit());
  24.         case 5:
  25.             a = a->p2->p1;
  26.             goto l1;
  27.         case 6:
  28.             return(binstr(nfree()));
  29.         }
  30.         writes("attempt to take an illegal value");
  31.         goto case0;
  32.     l1:
  33.         a = copy(a->p2);
  34.     }
  35.     return(a);
  36. }
  37.  
  38. eval(e, t)
  39. struct node *e;
  40. {
  41.     struct node *list, *a2, *a3, *a4, *a3base;
  42.     register struct node *a1, *stack, *op;
  43.  
  44.     if (rfail == 1)
  45.         return(0);
  46.     stack = 0;
  47.     list = e;
  48.     goto l1;
  49. advanc:
  50.     list = list->p1;
  51. l1:
  52.     op = list->typ;
  53.     switch (op) {
  54.         default:
  55.         case 0:
  56.         if (t == 1) {
  57.             a1 = and(stack);
  58.             goto e1;
  59.         }
  60.         if (stack->typ == 1)
  61.             writes("attempt to store in a value");
  62.         a1 = stack->p1;
  63.     e1:
  64.         stack = pop(stack);
  65.         if (stack)
  66.             writes("phase error");
  67.         return(a1);
  68.     case 12:
  69.         a1 = and(stack);
  70.         stack->p1 = look(a1);
  71.         delete(a1);
  72.         stack->typ = 0;
  73.         goto advanc;
  74.     case 13:
  75.         if (stack->typ)
  76.             writes("illegal function");
  77.         a1 = stack->p1;
  78.         if (a1->typ!=5)
  79.             writes("illegal function");
  80.         a1 = a1->p2;
  81.         op = a1->p1;
  82.         a3base = a3 = alloc();
  83.         a3->p2 = op->p2;
  84.         op->p2 = 0;
  85.         a1 = a1->p2;
  86.         a2 = list->p2;
  87.     f1:
  88.         if (a1!=0 & a2!=0)
  89.             goto f2;
  90.         if (a1!=a2)
  91.             writes("parameters do not match");
  92.         op = op->p1;
  93.         goto f3;
  94.     f2:
  95.         a3->p1 = a4 = alloc();
  96.         a3 = a4;
  97.         a3->p2 = and(a1);
  98.         assign(a1->p1, eval(a2->p2, 1));/* recursive */
  99.         a1 = a1->p2;
  100.         a2 = a2->p1;
  101.         goto f1;
  102.     f3:
  103.         op = execute(op); /* recursive */
  104.         if (op)
  105.             goto f3;
  106.         a1 = stack->p1->p2;
  107.         op = a1->p1;
  108.         a3 = a3base;
  109.         stack->p1 = op->p2;
  110.         stack->typ = 1;
  111.         op->p2 = a3->p2;
  112.     f4:
  113.         a4 = a3->p1;
  114.         free(a3);
  115.         a3 = a4;
  116.         a1 = a1->p2;
  117.         if (a1 == 0)
  118.             goto advanc;
  119.         assign(a1->p1, a3->p2);
  120.         goto f4;
  121.     case 11:
  122.     case 10:
  123.     case 9:
  124.     case 8:
  125.     case 7:
  126.         a1 = and(stack);
  127.         stack = pop(stack);
  128.         a2 = and(stack);
  129.         a3 = doop(op, a2, a1);
  130.         delete(a1);
  131.         delete(a2);
  132.         stack->p1 = a3;
  133.         stack->typ = 1;
  134.         goto advanc;
  135.     case 15:
  136.         a1 = copy(list->p2);
  137.         a2 = 1;
  138.         goto l3;
  139.     case 14:
  140.         a1 = list->p2;
  141.         a2 = 0;
  142.     l3:
  143.         stack = push(stack);
  144.         stack->p1 = a1;
  145.         stack->typ = a2;
  146.         goto advanc;
  147.     }
  148. }
  149.  
  150. doop(op, arg1, arg2)
  151. {
  152.     register int a1, a2;
  153.  
  154.     a1 = arg1;
  155.     a2 = arg2;
  156.     switch (op) {
  157.  
  158.     case 11:
  159.         return(div(a1, a2));
  160.     case 10:
  161.         return(mult(a1, a2));
  162.     case 8:
  163.         return(add(a1, a2));
  164.     case 9:
  165.         return(sub(a1, a2));
  166.     case 7:
  167.         return(cat(a1, a2));
  168.     }
  169.     return(0);
  170. }
  171.  
  172. execute(e)
  173. struct node *e;
  174. {
  175.     register struct node *r, *b, *c;
  176.     struct node *m, *ca, *d, *a;
  177.  
  178.     r = e->p2;
  179.     lc = e->ch;
  180.     switch (e->typ) {
  181.     case 0: /*  r g */
  182.         a = r->p1;
  183.         delete(eval(r->p2, 1));
  184.         goto xsuc;
  185.     case 1: /*  r m g */
  186.         m = r->p1;
  187.         a = m->p1;
  188.         b = eval(r->p2, 1);
  189.         c = search(m, b);
  190.         delete(b);
  191.         if (c == 0)
  192.             goto xfail;
  193.         free(c);
  194.         goto xsuc;
  195.     case 2: /*  r a g */
  196.         ca = r->p1;
  197.         a = ca->p1;
  198.         b = eval(r->p2, 0);
  199.         assign(b, eval(ca->p2, 1));
  200.         goto xsuc;
  201.     case 3: /*  r m a g */
  202.         m = r->p1;
  203.         ca = m->p1;
  204.         a = ca->p1;
  205.         b = eval(r->p2, 0);
  206.         d = search(m, b->p2);
  207.         if (d == 0)
  208.             goto xfail;
  209.         c = eval(ca->p2, 1);
  210.         if (d->p1 == 0) {
  211.             free(d);
  212.             assign(b, cat(c, b->p2));
  213.             delete(c);
  214.             goto xsuc;
  215.         }
  216.         if (d->p2 == b->p2->p2) {
  217.             assign(b, c);
  218.             free(d);
  219.             goto xsuc;
  220.         }
  221.         (r=alloc())->p1 = d->p2->p1;
  222.         r->p2 = b->p2->p2;
  223.         assign(b, cat(c, r));
  224.         free(d);
  225.         free(r);
  226.         delete(c);
  227.         goto xsuc;
  228.     }
  229. xsuc:
  230.     if (rfail)
  231.         goto xfail;
  232.     b = a->p1;
  233.     goto xboth;
  234. xfail:
  235.     rfail = 0;
  236.     b = a->p2;
  237. xboth:
  238.     if (b == 0) {
  239.         return(e->p1);
  240.     }
  241.     b = eval(b, 0);
  242.     if (b == lookret)
  243.         return(0);
  244.     if (b == lookfret) {
  245.         rfail = 1;
  246.         return(0);
  247.     }
  248.     if (b->typ!=2)
  249.         writes("attempt to transfer to non-label");
  250.     return(b->p2);
  251. }
  252.  
  253. assign(adr, val)
  254. struct node *adr, *val;
  255. {
  256.     register struct node *a, *addr, *value;
  257.  
  258.     addr = adr;
  259.     value = val;
  260.     if (rfail == 1) {
  261.         delete(value);
  262.         return;
  263.     }
  264.     switch (addr->typ) {
  265.     default:
  266.         writes("attempt to make an illegal assignment");
  267.     case 0:
  268.         addr->typ = 1;
  269.     case 1:
  270.         delete(addr->p2);
  271.         addr->p2 = value;
  272.         return;
  273.     case 4:
  274.         sysput(value);
  275.         return;
  276.     case 5:
  277.         a = addr->p2->p1;
  278.         delete(a->p2);
  279.         a->p2 = value;
  280.         return;
  281.     }
  282. }
  283.