home *** CD-ROM | disk | FTP | other *** search
/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Trees / V7 / usr / src / cmd / dc / dc.c next >
Encoding:
C/C++ Source or Header  |  1979-01-19  |  30.8 KB  |  1,942 lines

  1. #include <stdio.h>
  2. #include <signal.h>
  3. #include "dc.h"
  4. main(argc,argv)
  5. int argc;
  6. char *argv[];
  7. {
  8.     init(argc,argv);
  9.     commnds();
  10. }
  11. commnds(){
  12.     register int c;
  13.     register struct blk *p,*q;
  14.     long l;
  15.     int sign;
  16.     struct blk **ptr,*s,*t;
  17.     struct sym *sp;
  18.     int sk,sk1,sk2;
  19.     int n,d;
  20.  
  21.     while(1){
  22.         if(((c = readc())>='0' && c <= '9')|| (c>='A' && c <='F') || c == '.'){
  23.             unreadc(c);
  24.             p = readin();
  25.             pushp(p);
  26.             continue;
  27.         }
  28.         switch(c){
  29.         case ' ':
  30.         case '\n':
  31.         case 0377:
  32.         case EOF:
  33.             continue;
  34.         case 'Y':
  35.             sdump("stk",*stkptr);
  36.             printf("all %ld rel %ld headmor %ld\n",all,rel,headmor);
  37.             printf("nbytes %ld\n",nbytes);
  38.             continue;
  39.         case '_':
  40.             p = readin();
  41.             savk = sunputc(p);
  42.             chsign(p);
  43.             sputc(p,savk);
  44.             pushp(p);
  45.             continue;
  46.         case '-':
  47.             subt();
  48.             continue;
  49.         case '+':
  50.             if(eqk() != 0)continue;
  51.             binop('+');
  52.             continue;
  53.         case '*':
  54.             arg1 = pop();
  55.             EMPTY;
  56.             arg2 = pop();
  57.             EMPTYR(arg1);
  58.             sk1 = sunputc(arg1);
  59.             sk2 = sunputc(arg2);
  60.             binop('*');
  61.             p = pop();
  62.             sunputc(p);
  63.             savk = sk1+sk2;
  64.             if(savk>k && savk>sk1 && savk>sk2){
  65.                 sk = sk1;
  66.                 if(sk<sk2)sk = sk2;
  67.                 if(sk<k)sk = k;
  68.                 p = removc(p,savk-sk);
  69.                 savk = sk;
  70.             }
  71.             sputc(p,savk);
  72.             pushp(p);
  73.             continue;
  74.         case '/':
  75. casediv:
  76.             if(dscale() != 0)continue;
  77.             binop('/');
  78.             if(irem != 0)release(irem);
  79.             release(rem);
  80.             continue;
  81.         case '%':
  82.             if(dscale() != 0)continue;
  83.             binop('/');
  84.             p = pop();
  85.             release(p);
  86.             if(irem == 0){
  87.                 sputc(rem,skr+k);
  88.                 pushp(rem);
  89.                 continue;
  90.             }
  91.             p = add0(rem,skd-(skr+k));
  92.             q = add(p,irem);
  93.             release(p);
  94.             release(irem);
  95.             sputc(q,skd);
  96.             pushp(q);
  97.             continue;
  98.         case 'v':
  99.             p = pop();
  100.             EMPTY;
  101.             savk = sunputc(p);
  102.             if(length(p) == 0){
  103.                 sputc(p,savk);
  104.                 pushp(p);
  105.                 continue;
  106.             }
  107.             if((c = sbackc(p))<0){
  108.                 error("sqrt of neg number\n");
  109.             }
  110.             if(k<savk)n = savk;
  111.             else{
  112.                 n = k*2-savk;
  113.                 savk = k;
  114.             }
  115.             arg1 = add0(p,n);
  116.             arg2 = sqrt(arg1);
  117.             sputc(arg2,savk);
  118.             pushp(arg2);
  119.             continue;
  120.         case '^':
  121.             neg = 0;
  122.             arg1 = pop();
  123.             EMPTY;
  124.             if(sunputc(arg1) != 0)error("exp not an integer\n");
  125.             arg2 = pop();
  126.             EMPTYR(arg1);
  127.             if(sfbeg(arg1) == 0 && sbackc(arg1)<0){
  128.                 neg++;
  129.                 chsign(arg1);
  130.             }
  131.             if(length(arg1)>=3){
  132.                 error("exp too big\n");
  133.             }
  134.             savk = sunputc(arg2);
  135.             p = exp(arg2,arg1);
  136.             release(arg2);
  137.             rewind(arg1);
  138.             c = sgetc(arg1);
  139.             if(sfeof(arg1) == 0)
  140.                 c = sgetc(arg1)*100 + c;
  141.             d = c*savk;
  142.             release(arg1);
  143.             if(neg == 0){
  144.                 if(k>=savk)n = k;
  145.                 else n = savk;
  146.                 if(n<d){
  147.                     q = removc(p,d-n);
  148.                     sputc(q,n);
  149.                     pushp(q);
  150.                 }
  151.                 else {
  152.                     sputc(p,d);
  153.                     pushp(p);
  154.                 }
  155.             }
  156.             else {
  157.                 sputc(p,d);
  158.                 pushp(p);
  159.             }
  160.             if(neg == 0)continue;
  161.             p = pop();
  162.             q = salloc(2);
  163.             sputc(q,1);
  164.             sputc(q,0);
  165.             pushp(q);
  166.             pushp(p);
  167.             goto casediv;
  168.         case 'z':
  169.             p = salloc(2);
  170.             n = stkptr - stkbeg;
  171.             if(n >= 100){
  172.                 sputc(p,n/100);
  173.                 n %= 100;
  174.             }
  175.             sputc(p,n);
  176.             sputc(p,0);
  177.             pushp(p);
  178.             continue;
  179.         case 'Z':
  180.             p = pop();
  181.             EMPTY;
  182.             n = (length(p)-1)<<1;
  183.             fsfile(p);
  184.             sbackc(p);
  185.             if(sfbeg(p) == 0){
  186.                 if((c = sbackc(p))<0){
  187.                     n -= 2;
  188.                     if(sfbeg(p) == 1)n += 1;
  189.                     else {
  190.                         if((c = sbackc(p)) == 0)n += 1;
  191.                         else if(c > 90)n -= 1;
  192.                     }
  193.                 }
  194.                 else if(c < 10) n -= 1;
  195.             }
  196.             release(p);
  197.             q = salloc(1);
  198.             if(n >= 100){
  199.                 sputc(q,n%100);
  200.                 n /= 100;
  201.             }
  202.             sputc(q,n);
  203.             sputc(q,0);
  204.             pushp(q);
  205.             continue;
  206.         case 'i':
  207.             p = pop();
  208.             EMPTY;
  209.             p = scalint(p);
  210.             release(inbas);
  211.             inbas = p;
  212.             continue;
  213.         case 'I':
  214.             p = copy(inbas,length(inbas)+1);
  215.             sputc(p,0);
  216.             pushp(p);
  217.             continue;
  218.         case 'o':
  219.             p = pop();
  220.             EMPTY;
  221.             p = scalint(p);
  222.             sign = 0;
  223.             n = length(p);
  224.             q = copy(p,n);
  225.             fsfile(q);
  226.             l = c = sbackc(q);
  227.             if(n != 1){
  228.                 if(c<0){
  229.                     sign = 1;
  230.                     chsign(q);
  231.                     n = length(q);
  232.                     fsfile(q);
  233.                     l = c = sbackc(q);
  234.                 }
  235.                 if(n != 1){
  236.                     while(sfbeg(q) == 0)l = l*100+sbackc(q);
  237.                 }
  238.             }
  239.             logo = log2(l);
  240.             obase = l;
  241.             release(basptr);
  242.             if(sign == 1)obase = -l;
  243.             basptr = p;
  244.             outdit = bigot;
  245.             if(n == 1 && sign == 0){
  246.                 if(c <= 16){
  247.                     outdit = hexot;
  248.                     fw = 1;
  249.                     fw1 = 0;
  250.                     ll = 70;
  251.                     release(q);
  252.                     continue;
  253.                 }
  254.             }
  255.             n = 0;
  256.             if(sign == 1)n++;
  257.             p = salloc(1);
  258.             sputc(p,-1);
  259.             t = add(p,q);
  260.             n += length(t)*2;
  261.             fsfile(t);
  262.             if((c = sbackc(t))>9)n++;
  263.             release(t);
  264.             release(q);
  265.             release(p);
  266.             fw = n;
  267.             fw1 = n-1;
  268.             ll = 70;
  269.             if(fw>=ll)continue;
  270.             ll = (70/fw)*fw;
  271.             continue;
  272.         case 'O':
  273.             p = copy(basptr,length(basptr)+1);
  274.             sputc(p,0);
  275.             pushp(p);
  276.             continue;
  277.         case '[':
  278.             n = 0;
  279.             p = salloc(0);
  280.             while(1){
  281.                 if((c = readc()) == ']'){
  282.                     if(n == 0)break;
  283.                     n--;
  284.                 }
  285.                 sputc(p,c);
  286.                 if(c == '[')n++;
  287.             }
  288.             pushp(p);
  289.             continue;
  290.         case 'k':
  291.             p = pop();
  292.             EMPTY;
  293.             p = scalint(p);
  294.             if(length(p)>1){
  295.                 error("scale too big\n");
  296.             }
  297.             rewind(p);
  298.             k = sfeof(p)?0:sgetc(p);
  299.             release(scalptr);
  300.             scalptr = p;
  301.             continue;
  302.         case 'K':
  303.             p = copy(scalptr,length(scalptr)+1);
  304.             sputc(p,0);
  305.             pushp(p);
  306.             continue;
  307.         case 'X':
  308.             p = pop();
  309.             EMPTY;
  310.             fsfile(p);
  311.             n = sbackc(p);
  312.             release(p);
  313.             p = salloc(2);
  314.             sputc(p,n);
  315.             sputc(p,0);
  316.             pushp(p);
  317.             continue;
  318.         case 'Q':
  319.             p = pop();
  320.             EMPTY;
  321.             if(length(p)>2){
  322.                 error("Q?\n");
  323.             }
  324.             rewind(p);
  325.             if((c =  sgetc(p))<0){
  326.                 error("neg Q\n");
  327.             }
  328.             release(p);
  329.             while(c-- > 0){
  330.                 if(readptr == &readstk[0]){
  331.                     error("readstk?\n");
  332.                 }
  333.                 if(*readptr != 0)release(*readptr);
  334.                 readptr--;
  335.             }
  336.             continue;
  337.         case 'q':
  338.             if(readptr <= &readstk[1])exit(0);
  339.             if(*readptr != 0)release(*readptr);
  340.             readptr--;
  341.             if(*readptr != 0)release(*readptr);
  342.             readptr--;
  343.             continue;
  344.         case 'f':
  345.             if(stkptr == &stack[0])printf("empty stack\n");
  346.             else {
  347.                 for(ptr = stkptr; ptr > &stack[0];){
  348.                     print(*ptr--);
  349.                 }
  350.             }
  351.             continue;
  352.         case 'p':
  353.             if(stkptr == &stack[0])printf("empty stack\n");
  354.             else{
  355.                 print(*stkptr);
  356.             }
  357.             continue;
  358.         case 'P':
  359.             p = pop();
  360.             EMPTY;
  361.             sputc(p,0);
  362.             printf("%s",p->beg);
  363.             release(p);
  364.             continue;
  365.         case 'd':
  366.             if(stkptr == &stack[0]){
  367.                 printf("empty stack\n");
  368.                 continue;
  369.             }
  370.             q = *stkptr;
  371.             n = length(q);
  372.             p = copy(*stkptr,n);
  373.             pushp(p);
  374.             continue;
  375.         case 'c':
  376.             while(stkerr == 0){
  377.                 p = pop();
  378.                 if(stkerr == 0)release(p);
  379.             }
  380.             continue;
  381.         case 'S':
  382.             if(stkptr == &stack[0]){
  383.                 error("save: args\n");
  384.             }
  385.             c = readc() & 0377;
  386.             sptr = stable[c];
  387.             sp = stable[c] = sfree;
  388.             sfree = sfree->next;
  389.             if(sfree == 0)goto sempty;
  390.             sp->next = sptr;
  391.             p = pop();
  392.             EMPTY;
  393.             if(c >= ARRAYST){
  394.                 q = copy(p,PTRSZ);
  395.                 for(n = 0;n < PTRSZ-1;n++)sputc(q,0);
  396.                 release(p);
  397.                 p = q;
  398.             }
  399.             sp->val = p;
  400.             continue;
  401. sempty:
  402.             error("symbol table overflow\n");
  403.         case 's':
  404.             if(stkptr == &stack[0]){
  405.                 error("save:args\n");
  406.             }
  407.             c = readc() & 0377;
  408.             sptr = stable[c];
  409.             if(sptr != 0){
  410.                 p = sptr->val;
  411.                 if(c >= ARRAYST){
  412.                     rewind(p);
  413.                     while(sfeof(p) == 0)release(getwd(p));
  414.                 }
  415.                 release(p);
  416.             }
  417.             else{
  418.                 sptr = stable[c] = sfree;
  419.                 sfree = sfree->next;
  420.                 if(sfree == 0)goto sempty;
  421.                 sptr->next = 0;
  422.             }
  423.             p = pop();
  424.             sptr->val = p;
  425.             continue;
  426.         case 'l':
  427.             load();
  428.             continue;
  429.         case 'L':
  430.             c = readc() & 0377;
  431.             sptr = stable[c];
  432.             if(sptr == 0){
  433.                 error("L?\n");
  434.             }
  435.             stable[c] = sptr->next;
  436.             sptr->next = sfree;
  437.             sfree = sptr;
  438.             p = sptr->val;
  439.             if(c >= ARRAYST){
  440.                 rewind(p);
  441.                 while(sfeof(p) == 0){
  442.                     q = getwd(p);
  443.                     if(q != 0)release(q);
  444.                 }
  445.             }
  446.             pushp(p);
  447.             continue;
  448.         case ':':
  449.             p = pop();
  450.             EMPTY;
  451.             q = scalint(p);
  452.             fsfile(q);
  453.             c = 0;
  454.             if((sfbeg(q) == 0) && ((c = sbackc(q))<0)){
  455.                 error("neg index\n");
  456.             }
  457.             if(length(q)>2){
  458.                 error("index too big\n");
  459.             }
  460.             if(sfbeg(q) == 0)c = c*100+sbackc(q);
  461.             if(c >= MAXIND){
  462.                 error("index too big\n");
  463.             }
  464.             release(q);
  465.             n = readc() & 0377;
  466.             sptr = stable[n];
  467.             if(sptr == 0){
  468.                 sptr = stable[n] = sfree;
  469.                 sfree = sfree->next;
  470.                 if(sfree == 0)goto sempty;
  471.                 sptr->next = 0;
  472.                 p = salloc((c+PTRSZ)*PTRSZ);
  473.                 zero(p);
  474.             }
  475.             else{
  476.                 p = sptr->val;
  477.                 if(length(p)-PTRSZ < c*PTRSZ){
  478.                     q = copy(p,(c+PTRSZ)*PTRSZ);
  479.                     release(p);
  480.                     p = q;
  481.                 }
  482.             }
  483.             seekc(p,c*PTRSZ);
  484.             q = lookwd(p);
  485.             if (q!=NULL) release(q);
  486.             s = pop();
  487.             EMPTY;
  488.             salterwd(p,s);
  489.             sptr->val = p;
  490.             continue;
  491.         case ';':
  492.             p = pop();
  493.             EMPTY;
  494.             q = scalint(p);
  495.             fsfile(q);
  496.             c = 0;
  497.             if((sfbeg(q) == 0) && ((c = sbackc(q))<0)){
  498.                 error("neg index\n");
  499.             }
  500.             if(length(q)>2){
  501.                 error("index too big\n");
  502.             }
  503.             if(sfbeg(q) == 0)c = c*100+sbackc(q);
  504.             if(c >= MAXIND){
  505.                 error("index too big\n");
  506.             }
  507.             release(q);
  508.             n = readc() & 0377;
  509.             sptr = stable[n];
  510.             if(sptr != 0){
  511.                 p = sptr->val;
  512.                 if(length(p)-PTRSZ >= c*PTRSZ){
  513.                     seekc(p,c*PTRSZ);
  514.                     s = getwd(p);
  515.                     if(s != 0){
  516.                         q = copy(s,length(s));
  517.                         pushp(q);
  518.                         continue;
  519.                     }
  520.                 }
  521.             }
  522.             q = salloc(PTRSZ);
  523.             putwd(q, (struct blk *)0);
  524.             pushp(q);
  525.             continue;
  526.         case 'x':
  527. execute:
  528.             p = pop();
  529.             EMPTY;
  530.             if((readptr != &readstk[0]) && (*readptr != 0)){
  531.                 if((*readptr)->rd == (*readptr)->wt)
  532.                     release(*readptr);
  533.                 else{
  534.                     if(readptr++ == &readstk[RDSKSZ]){
  535.                         error("nesting depth\n");
  536.                     }
  537.                 }
  538.             }
  539.             else readptr++;
  540.             *readptr = p;
  541.             if(p != 0)rewind(p);
  542.             else{
  543.                 if((c = readc()) != '\n')unreadc(c);
  544.             }
  545.             continue;
  546.         case '?':
  547.             if(++readptr == &readstk[RDSKSZ]){
  548.                 error("nesting depth\n");
  549.             }
  550.             *readptr = 0;
  551.             fsave = curfile;
  552.             curfile = stdin;
  553.             while((c = readc()) == '!')command();
  554.             p = salloc(0);
  555.             sputc(p,c);
  556.             while((c = readc()) != '\n'){
  557.                 sputc(p,c);
  558.                 if(c == '\\')sputc(p,readc());
  559.             }
  560.             curfile = fsave;
  561.             *readptr = p;
  562.             continue;
  563.         case '!':
  564.             if(command() == 1)goto execute;
  565.             continue;
  566.         case '<':
  567.         case '>':
  568.         case '=':
  569.             if(cond(c) == 1)goto execute;
  570.             continue;
  571.         default:
  572.             printf("%o is unimplemented\n",c);
  573.         }
  574.     }
  575. }
  576. struct blk *
  577. div(ddivd,ddivr)
  578. struct blk *ddivd,*ddivr;
  579. {
  580.     int divsign,remsign,offset,divcarry;
  581.     int carry, dig,magic,d,dd;
  582.     long c,td,cc;
  583.     struct blk *ps;
  584.     register struct blk *p,*divd,*divr;
  585.  
  586.     rem = 0;
  587.     p = salloc(0);
  588.     if(length(ddivr) == 0){
  589.         pushp(ddivr);
  590.         errorrt("divide by 0\n");
  591.     }
  592.     divsign = remsign = 0;
  593.     divr = ddivr;
  594.     fsfile(divr);
  595.     if(sbackc(divr) == -1){
  596.         divr = copy(ddivr,length(ddivr));
  597.         chsign(divr);
  598.         divsign = ~divsign;
  599.     }
  600.     divd = copy(ddivd,length(ddivd));
  601.     fsfile(divd);
  602.     if(sfbeg(divd) == 0 && sbackc(divd) == -1){
  603.         chsign(divd);
  604.         divsign = ~divsign;
  605.         remsign = ~remsign;
  606.     }
  607.     offset = length(divd) - length(divr);
  608.     if(offset < 0)goto ddone;
  609.     seekc(p,offset+1);
  610.     sputc(divd,0);
  611.     magic = 0;
  612.     fsfile(divr);
  613.     c = sbackc(divr);
  614.     if(c<10)magic++;
  615.     c = c*100 + (sfbeg(divr)?0:sbackc(divr));
  616.     if(magic>0){
  617.         c = (c*100 +(sfbeg(divr)?0:sbackc(divr)))*2;
  618.         c /= 25;
  619.     }
  620.     while(offset >= 0){
  621.         fsfile(divd);
  622.         td = sbackc(divd)*100;
  623.         dd = sfbeg(divd)?0:sbackc(divd);
  624.         td = (td+dd)*100;
  625.         dd = sfbeg(divd)?0:sbackc(divd);
  626.         td = td+dd;
  627.         cc = c;
  628.         if(offset == 0)td += 1;
  629.         else cc += 1;
  630.         if(magic != 0)td = td<<3;
  631.         dig = td/cc;
  632.         rewind(divr);
  633.         rewind(divxyz);
  634.         carry = 0;
  635.         while(sfeof(divr) == 0){
  636.             d = sgetc(divr)*dig+carry;
  637.             carry = d / 100;
  638.             salterc(divxyz,d%100);
  639.         }
  640.         salterc(divxyz,carry);
  641.         rewind(divxyz);
  642.         seekc(divd,offset);
  643.         carry = 0;
  644.         while(sfeof(divd) == 0){
  645.             d = slookc(divd);
  646.             d = d-(sfeof(divxyz)?0:sgetc(divxyz))-carry;
  647.             carry = 0;
  648.             if(d < 0){
  649.                 d += 100;
  650.                 carry = 1;
  651.             }
  652.             salterc(divd,d);
  653.         }
  654.         divcarry = carry;
  655.         sbackc(p);
  656.         salterc(p,dig);
  657.         sbackc(p);
  658.         if(--offset >= 0)divd->wt--;
  659.     }
  660.     if(divcarry != 0){
  661.         salterc(p,dig-1);
  662.         salterc(divd,-1);
  663.         ps = add(divr,divd);
  664.         release(divd);
  665.         divd = ps;
  666.     }
  667.  
  668.     rewind(p);
  669.     divcarry = 0;
  670.     while(sfeof(p) == 0){
  671.         d = slookc(p)+divcarry;
  672.         divcarry = 0;
  673.         if(d >= 100){
  674.             d -= 100;
  675.             divcarry = 1;
  676.         }
  677.         salterc(p,d);
  678.     }
  679.     if(divcarry != 0)salterc(p,divcarry);
  680.     fsfile(p);
  681.     while(sfbeg(p) == 0){
  682.         if(sbackc(p) == 0)truncate(p);
  683.         else break;
  684.     }
  685.     if(divsign < 0)chsign(p);
  686.     fsfile(divd);
  687.     while(sfbeg(divd) == 0){
  688.         if(sbackc(divd) == 0)truncate(divd);
  689.         else break;
  690.     }
  691. ddone:
  692.     if(remsign<0)chsign(divd);
  693.     if(divr != ddivr)release(divr);
  694.     rem = divd;
  695.     return(p);
  696. }
  697. dscale(){
  698.     register struct blk *dd,*dr;
  699.     register struct blk *r;
  700.     int c;
  701.  
  702.     dr = pop();
  703.     EMPTYS;
  704.     dd = pop();
  705.     EMPTYSR(dr);
  706.     fsfile(dd);
  707.     skd = sunputc(dd);
  708.     fsfile(dr);
  709.     skr = sunputc(dr);
  710.     if(sfbeg(dr) == 1 || (sfbeg(dr) == 0 && sbackc(dr) == 0)){
  711.         sputc(dr,skr);
  712.         pushp(dr);
  713.         errorrt("divide by 0\n");
  714.     }
  715.     c = k-skd+skr;
  716.     if(c < 0)r = removr(dd,-c);
  717.     else {
  718.         r = add0(dd,c);
  719.         irem = 0;
  720.     }
  721.     arg1 = r;
  722.     arg2 = dr;
  723.     savk = k;
  724.     return(0);
  725. }
  726. struct blk *
  727. removr(p,n)
  728. struct blk *p;
  729. {
  730.     int nn;
  731.     register struct blk *q,*s,*r;
  732.  
  733.     rewind(p);
  734.     nn = (n+1)/2;
  735.     q = salloc(nn);
  736.     while(n>1){
  737.         sputc(q,sgetc(p));
  738.         n -= 2;
  739.     }
  740.     r = salloc(2);
  741.     while(sfeof(p) == 0)sputc(r,sgetc(p));
  742.     release(p);
  743.     if(n == 1){
  744.         s = div(r,tenptr);
  745.         release(r);
  746.         rewind(rem);
  747.         if(sfeof(rem) == 0)sputc(q,sgetc(rem));
  748.         release(rem);
  749.         irem = q;
  750.         return(s);
  751.     }
  752.     irem = q;
  753.     return(r);
  754. }
  755. struct blk *
  756. sqrt(p)
  757. struct blk *p;
  758. {
  759.     struct blk *t;
  760.     struct blk *r,*q,*s;
  761.     int c,n,nn;
  762.  
  763.     n = length(p);
  764.     fsfile(p);
  765.     c = sbackc(p);
  766.     if((n&1) != 1)c = c*100+(sfbeg(p)?0:sbackc(p));
  767.     n = (n+1)>>1;
  768.     r = salloc(n);
  769.     zero(r);
  770.     seekc(r,n);
  771.     nn=1;
  772.     while((c -= nn)>=0)nn+=2;
  773.     c=(nn+1)>>1;
  774.     fsfile(r);
  775.     sbackc(r);
  776.     if(c>=100){
  777.         c -= 100;
  778.         salterc(r,c);
  779.         sputc(r,1);
  780.     }
  781.     else salterc(r,c);
  782.     while(1){
  783.         q = div(p,r);
  784.         s = add(q,r);
  785.         release(q);
  786.         release(rem);
  787.         q = div(s,sqtemp);
  788.         release(s);
  789.         release(rem);
  790.         s = copy(r,length(r));
  791.         chsign(s);
  792.         t = add(s,q);
  793.         release(s);
  794.         fsfile(t);
  795.         nn = sfbeg(t)?0:sbackc(t);
  796.         if(nn>=0)break;
  797.         release(r);
  798.         release(t);
  799.         r = q;
  800.     }
  801.     release(t);
  802.     release(q);
  803.     release(p);
  804.     return(r);
  805. }
  806. struct blk *
  807. exp(base,ex)
  808. struct blk *base,*ex;
  809. {
  810.     register struct blk *r,*e,*p;
  811.     struct blk *e1,*t,*cp;
  812.     int temp,c,n;
  813.     r = salloc(1);
  814.     sputc(r,1);
  815.     p = copy(base,length(base));
  816.     e = copy(ex,length(ex));
  817.     fsfile(e);
  818.     if(sfbeg(e) != 0)goto edone;
  819.     temp=0;
  820.     c = sbackc(e);
  821.     if(c<0){
  822.         temp++;
  823.         chsign(e);
  824.     }
  825.     while(length(e) != 0){
  826.         e1=div(e,sqtemp);
  827.         release(e);
  828.         e = e1;
  829.         n = length(rem);
  830.         release(rem);
  831.         if(n != 0){
  832.             e1=mult(p,r);
  833.             release(r);
  834.             r = e1;
  835.         }
  836.         t = copy(p,length(p));
  837.         cp = mult(p,t);
  838.         release(p);
  839.         release(t);
  840.         p = cp;
  841.     }
  842.     if(temp != 0){
  843.         if((c = length(base)) == 0){
  844.             goto edone;
  845.         }
  846.         if(c>1)create(r);
  847.         else{
  848.             rewind(base);
  849.             if((c = sgetc(base))<=1){
  850.                 create(r);
  851.                 sputc(r,c);
  852.             }
  853.             else create(r);
  854.         }
  855.     }
  856. edone:
  857.     release(p);
  858.     release(e);
  859.     return(r);
  860. }
  861. init(argc,argv)
  862. int argc;
  863. char *argv[];
  864. {
  865.     register struct sym *sp;
  866.  
  867.     if (signal(SIGINT, SIG_IGN) != SIG_IGN)
  868.         signal(SIGINT,onintr);
  869.     setbuf(stdout,(char *)NULL);
  870.     svargc = --argc;
  871.     svargv = argv;
  872.     while(svargc>0 && svargv[1][0] == '-'){
  873.         switch(svargv[1][1]){
  874.         default:
  875.             dbg=1;
  876.         }
  877.         svargc--;
  878.         svargv++;
  879.     }
  880.     ifile=1;
  881.     if(svargc<=0)curfile = stdin;
  882.     else if((curfile = fopen(svargv[1],"r")) == NULL){
  883.         printf("can't open file %s\n",svargv[1]);
  884.         exit(1);
  885.         }
  886.     dummy = malloc(1);
  887.     scalptr = salloc(1);
  888.     sputc(scalptr,0);
  889.     basptr = salloc(1);
  890.     sputc(basptr,10);
  891.     obase=10;
  892.     log10=log2(10L);
  893.     ll=70;
  894.     fw=1;
  895.     fw1=0;
  896.     tenptr = salloc(1);
  897.     sputc(tenptr,10);
  898.     obase=10;
  899.     inbas = salloc(1);
  900.     sputc(inbas,10);
  901.     sqtemp = salloc(1);
  902.     sputc(sqtemp,2);
  903.     chptr = salloc(0);
  904.     strptr = salloc(0);
  905.     divxyz = salloc(0);
  906.     stkbeg = stkptr = &stack[0];
  907.     stkend = &stack[STKSZ];
  908.     stkerr = 0;
  909.     readptr = &readstk[0];
  910.     k=0;
  911.     sp = sptr = &symlst[0];
  912.     while(sptr < &symlst[TBLSZ]){
  913.         sptr->next = ++sp;
  914.         sptr++;
  915.     }
  916.     sptr->next=0;
  917.     sfree = &symlst[0];
  918.     return;
  919. }
  920. onintr(){
  921.  
  922.     signal(SIGINT,onintr);
  923.     while(readptr != &readstk[0]){
  924.         if(*readptr != 0){release(*readptr);}
  925.         readptr--;
  926.     }
  927.     curfile = stdin;
  928.     commnds();
  929. }
  930. pushp(p)
  931. struct blk *p;
  932. {
  933.     if(stkptr == stkend){
  934.         printf("out of stack space\n");
  935.         return;
  936.     }
  937.     stkerr=0;
  938.     *++stkptr = p;
  939.     return;
  940. }
  941. struct blk *
  942. pop(){
  943.     if(stkptr == stack){
  944.         stkerr=1;
  945.         return(0);
  946.     }
  947.     return(*stkptr--);
  948. }
  949. struct blk *
  950. readin(){
  951.     register struct blk *p,*q;
  952.     int dp,dpct;
  953.     register int c;
  954.  
  955.     dp = dpct=0;
  956.     p = salloc(0);
  957.     while(1){
  958.         c = readc();
  959.         switch(c){
  960.         case '.':
  961.             if(dp != 0){
  962.                 unreadc(c);
  963.                 break;
  964.             }
  965.             dp++;
  966.             continue;
  967.         case '\\':
  968.             readc();
  969.             continue;
  970.         default:
  971.             if(c >= 'A' && c <= 'F')c = c - 'A' + 10;
  972.             else if(c >= '0' && c <= '9')c -= '0';
  973.             else goto gotnum;
  974.             if(dp != 0){
  975.                 if(dpct >= 99)continue;
  976.                 dpct++;
  977.             }
  978.             create(chptr);
  979.             if(c != 0)sputc(chptr,c);
  980.             q = mult(p,inbas);
  981.             release(p);
  982.             p = add(chptr,q);
  983.             release(q);
  984.         }
  985.     }
  986. gotnum:
  987.     unreadc(c);
  988.     if(dp == 0){
  989.         sputc(p,0);
  990.         return(p);
  991.     }
  992.     else{
  993.         q = scale(p,dpct);
  994.         return(q);
  995.     }
  996. }
  997. struct blk *
  998. add0(p,ct)
  999. int ct;
  1000. struct blk *p;
  1001. {
  1002.         /* returns pointer to struct with ct 0's & p */
  1003.     register struct blk *q,*t;
  1004.  
  1005.     q = salloc(length(p)+(ct+1)/2);
  1006.     while(ct>1){
  1007.         sputc(q,0);
  1008.         ct -= 2;
  1009.     }
  1010.     rewind(p);
  1011.     while(sfeof(p) == 0){
  1012.         sputc(q,sgetc(p));
  1013.     }
  1014.     release(p);
  1015.     if(ct == 1){
  1016.         t = mult(tenptr,q);
  1017.         release(q);
  1018.         return(t);
  1019.     }
  1020.     return(q);
  1021. }
  1022. struct blk *
  1023. mult(p,q)
  1024. struct blk *p,*q;
  1025. {
  1026.     register struct blk *mp,*mq,*mr;
  1027.     int sign,offset,carry;
  1028.     int cq,cp,mt,mcr;
  1029.  
  1030.     offset = sign = 0;
  1031.     fsfile(p);
  1032.     mp = p;
  1033.     if(sfbeg(p) == 0){
  1034.         if(sbackc(p)<0){
  1035.             mp = copy(p,length(p));
  1036.             chsign(mp);
  1037.             sign = ~sign;
  1038.         }
  1039.     }
  1040.     fsfile(q);
  1041.     mq = q;
  1042.     if(sfbeg(q) == 0){
  1043.         if(sbackc(q)<0){
  1044.             mq = copy(q,length(q));
  1045.             chsign(mq);
  1046.             sign = ~sign;
  1047.         }
  1048.     }
  1049.     mr = salloc(length(mp)+length(mq));
  1050.     zero(mr);
  1051.     rewind(mq);
  1052.     while(sfeof(mq) == 0){
  1053.         cq = sgetc(mq);
  1054.         rewind(mp);
  1055.         rewind(mr);
  1056.         mr->rd += offset;
  1057.         carry=0;
  1058.         while(sfeof(mp) == 0){
  1059.             cp = sgetc(mp);
  1060.             mcr = sfeof(mr)?0:slookc(mr);
  1061.             mt = cp*cq + carry + mcr;
  1062.             carry = mt/100;
  1063.             salterc(mr,mt%100);
  1064.         }
  1065.         offset++;
  1066.         if(carry != 0){
  1067.             mcr = sfeof(mr)?0:slookc(mr);
  1068.             salterc(mr,mcr+carry);
  1069.         }
  1070.     }
  1071.     if(sign < 0){
  1072.         chsign(mr);
  1073.     }
  1074.     if(mp != p)release(mp);
  1075.     if(mq != q)release(mq);
  1076.     return(mr);
  1077. }
  1078. chsign(p)
  1079. struct blk *p;
  1080. {
  1081.     register int carry;
  1082.     register char ct;
  1083.  
  1084.     carry=0;
  1085.     rewind(p);
  1086.     while(sfeof(p) == 0){
  1087.         ct=100-slookc(p)-carry;
  1088.         carry=1;
  1089.         if(ct>=100){
  1090.             ct -= 100;
  1091.             carry=0;
  1092.         }
  1093.         salterc(p,ct);
  1094.     }
  1095.     if(carry != 0){
  1096.         sputc(p,-1);
  1097.         fsfile(p);
  1098.         sbackc(p);
  1099.         ct = sbackc(p);
  1100.         if(ct == 99){
  1101.             truncate(p);
  1102.             sputc(p,-1);
  1103.         }
  1104.     }
  1105.     else{
  1106.         fsfile(p);
  1107.         ct = sbackc(p);
  1108.         if(ct == 0)truncate(p);
  1109.     }
  1110.     return;
  1111. }
  1112. readc(){
  1113. loop:
  1114.     if((readptr != &readstk[0]) && (*readptr != 0)){
  1115.         if(sfeof(*readptr) == 0)return(lastchar = sgetc(*readptr));
  1116.         release(*readptr);
  1117.         readptr--;
  1118.         goto loop;
  1119.     }
  1120.     lastchar = getc(curfile);
  1121.     if(lastchar != EOF)return(lastchar);
  1122.     if(readptr != &readptr[0]){
  1123.         readptr--;
  1124.         if(*readptr == 0)curfile = stdin;
  1125.         goto loop;
  1126.     }
  1127.     if(curfile != stdin){
  1128.         fclose(curfile);
  1129.         curfile = stdin;
  1130.         goto loop;
  1131.     }
  1132.     exit(0);
  1133. }
  1134. unreadc(c)
  1135. char c;
  1136. {
  1137.  
  1138.     if((readptr != &readstk[0]) && (*readptr != 0)){
  1139.         sungetc(*readptr,c);
  1140.     }
  1141.     else ungetc(c,curfile);
  1142.     return;
  1143. }
  1144. binop(c)
  1145. char c;
  1146. {
  1147.     register struct blk *r;
  1148.  
  1149.     switch(c){
  1150.     case '+':
  1151.         r = add(arg1,arg2);
  1152.         break;
  1153.     case '*':
  1154.         r = mult(arg1,arg2);
  1155.         break;
  1156.     case '/':
  1157.         r = div(arg1,arg2);
  1158.         break;
  1159.     }
  1160.     release(arg1);
  1161.     release(arg2);
  1162.     sputc(r,savk);
  1163.     pushp(r);
  1164.     return;
  1165. }
  1166. print(hptr)
  1167. struct blk *hptr;
  1168. {
  1169.     int sc;
  1170.     register struct blk *p,*q,*dec;
  1171.     int dig,dout,ct;
  1172.  
  1173.     rewind(hptr);
  1174.     while(sfeof(hptr) == 0){
  1175.         if(sgetc(hptr)>99){
  1176.             rewind(hptr);
  1177.             while(sfeof(hptr) == 0){
  1178.                 printf("%c",sgetc(hptr));
  1179.             }
  1180.             printf("\n");
  1181.             return;
  1182.         }
  1183.     }
  1184.     fsfile(hptr);
  1185.     sc = sbackc(hptr);
  1186.     if(sfbeg(hptr) != 0){
  1187.         printf("0\n");
  1188.         return;
  1189.     }
  1190.     count = ll;
  1191.     p = copy(hptr,length(hptr));
  1192.     sunputc(p);
  1193.     fsfile(p);
  1194.     if(sbackc(p)<0){
  1195.         chsign(p);
  1196.         OUTC('-');
  1197.     }
  1198.     if((obase == 0) || (obase == -1)){
  1199.         oneot(p,sc,'d');
  1200.         return;
  1201.     }
  1202.     if(obase == 1){
  1203.         oneot(p,sc,'1');
  1204.         return;
  1205.     }
  1206.     if(obase == 10){
  1207.         tenot(p,sc);
  1208.         return;
  1209.     }
  1210.     create(strptr);
  1211.     dig = log10*sc;
  1212.     dout = ((dig/10) + dig) /logo;
  1213.     dec = getdec(p,sc);
  1214.     p = removc(p,sc);
  1215.     while(length(p) != 0){
  1216.         q = div(p,basptr);
  1217.         release(p);
  1218.         p = q;
  1219.         (*outdit)(rem,0);
  1220.     }
  1221.     release(p);
  1222.     fsfile(strptr);
  1223.     while(sfbeg(strptr) == 0)OUTC(sbackc(strptr));
  1224.     if(sc == 0){
  1225.         release(dec);
  1226.         printf("\n");
  1227.         return;
  1228.     }
  1229.     create(strptr);
  1230.     OUTC('.');
  1231.     ct=0;
  1232.     do{
  1233.         q = mult(basptr,dec);
  1234.         release(dec);
  1235.         dec = getdec(q,sc);
  1236.         p = removc(q,sc);
  1237.         (*outdit)(p,1);
  1238.     }while(++ct < dout);
  1239.     release(dec);
  1240.     rewind(strptr);
  1241.     while(sfeof(strptr) == 0)OUTC(sgetc(strptr));
  1242.     printf("\n");
  1243.     return;
  1244. }
  1245.  
  1246. struct blk *
  1247. getdec(p,sc)
  1248. struct blk *p;
  1249. {
  1250.     int cc;
  1251.     register struct blk *q,*t,*s;
  1252.  
  1253.     rewind(p);
  1254.     if(length(p)*2 < sc){
  1255.         q = copy(p,length(p));
  1256.         return(q);
  1257.     }
  1258.     q = salloc(length(p));
  1259.     while(sc >= 1){
  1260.         sputc(q,sgetc(p));
  1261.         sc -= 2;
  1262.     }
  1263.     if(sc != 0){
  1264.         t = mult(q,tenptr);
  1265.         s = salloc(cc = length(q));
  1266.         release(q);
  1267.         rewind(t);
  1268.         while(cc-- > 0)sputc(s,sgetc(t));
  1269.         sputc(s,0);
  1270.         release(t);
  1271.         t = div(s,tenptr);
  1272.         release(s);
  1273.         release(rem);
  1274.         return(t);
  1275.     }
  1276.     return(q);
  1277. }
  1278. tenot(p,sc)
  1279. struct blk *p;
  1280. {
  1281.     register int c,f;
  1282.  
  1283.     fsfile(p);
  1284.     f=0;
  1285.     while((sfbeg(p) == 0) && ((p->rd-p->beg-1)*2 >= sc)){
  1286.         c = sbackc(p);
  1287.         if((c<10) && (f == 1))printf("0%d",c);
  1288.         else printf("%d",c);
  1289.         f=1;
  1290.         TEST2;
  1291.     }
  1292.     if(sc == 0){
  1293.         printf("\n");
  1294.         release(p);
  1295.         return;
  1296.     }
  1297.     if((p->rd-p->beg)*2 > sc){
  1298.         c = sbackc(p);
  1299.         printf("%d.",c/10);
  1300.         TEST2;
  1301.         OUTC(c%10 +'0');
  1302.         sc--;
  1303.     }
  1304.     else {
  1305.         OUTC('.');
  1306.     }
  1307.     if(sc > (p->rd-p->beg)*2){
  1308.         while(sc>(p->rd-p->beg)*2){
  1309.             OUTC('0');
  1310.             sc--;
  1311.         }
  1312.     }
  1313.     while(sc > 1){
  1314.         c = sbackc(p);
  1315.         if(c<10)printf("0%d",c);
  1316.         else printf("%d",c);
  1317.         sc -= 2;
  1318.         TEST2;
  1319.     }
  1320.     if(sc == 1){
  1321.         OUTC(sbackc(p)/10 +'0');
  1322.     }
  1323.     printf("\n");
  1324.     release(p);
  1325.     return;
  1326. }
  1327. oneot(p,sc,ch)
  1328. struct blk *p;
  1329. char ch;
  1330. {
  1331.     register struct blk *q;
  1332.  
  1333.     q = removc(p,sc);
  1334.     create(strptr);
  1335.     sputc(strptr,-1);
  1336.     while(length(q)>0){
  1337.         p = add(strptr,q);
  1338.         release(q);
  1339.         q = p;
  1340.         OUTC(ch);
  1341.     }
  1342.     release(q);
  1343.     printf("\n");
  1344.     return;
  1345. }
  1346. hexot(p,flg)
  1347. struct blk *p;
  1348. {
  1349.     register int c;
  1350.     rewind(p);
  1351.     if(sfeof(p) != 0){
  1352.         sputc(strptr,'0');
  1353.         release(p);
  1354.         return;
  1355.     }
  1356.     c = sgetc(p);
  1357.     release(p);
  1358.     if(c >= 16){
  1359.         printf("hex digit > 16");
  1360.         return;
  1361.     }
  1362.     sputc(strptr,c<10?c+'0':c-10+'A');
  1363.     return;
  1364. }
  1365. bigot(p,flg)
  1366. struct blk *p;
  1367. {
  1368.     register struct blk *t,*q;
  1369.     register int l;
  1370.     int neg;
  1371.  
  1372.     if(flg == 1)t = salloc(0);
  1373.     else{
  1374.         t = strptr;
  1375.         l = length(strptr)+fw-1;
  1376.     }
  1377.     neg=0;
  1378.     if(length(p) != 0){
  1379.         fsfile(p);
  1380.         if(sbackc(p)<0){
  1381.             neg=1;
  1382.             chsign(p);
  1383.         }
  1384.         while(length(p) != 0){
  1385.             q = div(p,tenptr);
  1386.             release(p);
  1387.             p = q;
  1388.             rewind(rem);
  1389.             sputc(t,sfeof(rem)?'0':sgetc(rem)+'0');
  1390.             release(rem);
  1391.         }
  1392.     }
  1393.     release(p);
  1394.     if(flg == 1){
  1395.         l = fw1-length(t);
  1396.         if(neg != 0){
  1397.             l--;
  1398.             sputc(strptr,'-');
  1399.         }
  1400.         fsfile(t);
  1401.         while(l-- > 0)sputc(strptr,'0');
  1402.         while(sfbeg(t) == 0)sputc(strptr,sbackc(t));
  1403.         release(t);
  1404.     }
  1405.     else{
  1406.         l -= length(strptr);
  1407.         while(l-- > 0)sputc(strptr,'0');
  1408.         if(neg != 0){
  1409.             sunputc(strptr);
  1410.             sputc(strptr,'-');
  1411.         }
  1412.     }
  1413.     sputc(strptr,' ');
  1414.     return;
  1415. }
  1416. struct blk *
  1417. add(a1,a2)
  1418. struct blk *a1,*a2;
  1419. {
  1420.     register struct blk *p;
  1421.     register int carry,n;
  1422.     int size;
  1423.     int c,n1,n2;
  1424.  
  1425.     size = length(a1)>length(a2)?length(a1):length(a2);
  1426.     p = salloc(size);
  1427.     rewind(a1);
  1428.     rewind(a2);
  1429.     carry=0;
  1430.     while(--size >= 0){
  1431.         n1 = sfeof(a1)?0:sgetc(a1);
  1432.         n2 = sfeof(a2)?0:sgetc(a2);
  1433.         n = n1 + n2 + carry;
  1434.         if(n>=100){
  1435.             carry=1;
  1436.             n -= 100;
  1437.         }
  1438.         else if(n<0){
  1439.             carry = -1;
  1440.             n += 100;
  1441.         }
  1442.         else carry = 0;
  1443.         sputc(p,n);
  1444.     }
  1445.     if(carry != 0)sputc(p,carry);
  1446.     fsfile(p);
  1447.     if(sfbeg(p) == 0){
  1448.         while(sfbeg(p) == 0 && (c = sbackc(p)) == 0);
  1449.         if(c != 0)salterc(p,c);
  1450.         truncate(p);
  1451.     }
  1452.     fsfile(p);
  1453.     if(sfbeg(p) == 0 && sbackc(p) == -1){
  1454.         while((c = sbackc(p)) == 99){
  1455.             if(c == EOF)break;
  1456.         }
  1457.         sgetc(p);
  1458.         salterc(p,-1);
  1459.         truncate(p);
  1460.     }
  1461.     return(p);
  1462. }
  1463. eqk(){
  1464.     register struct blk *p,*q;
  1465.     register int skp;
  1466.     int skq;
  1467.  
  1468.     p = pop();
  1469.     EMPTYS;
  1470.     q = pop();
  1471.     EMPTYSR(p);
  1472.     skp = sunputc(p);
  1473.     skq = sunputc(q);
  1474.     if(skp == skq){
  1475.         arg1=p;
  1476.         arg2=q;
  1477.         savk = skp;
  1478.         return(0);
  1479.     }
  1480.     else if(skp < skq){
  1481.         savk = skq;
  1482.         p = add0(p,skq-skp);
  1483.     }
  1484.     else {
  1485.         savk = skp;
  1486.         q = add0(q,skp-skq);
  1487.     }
  1488.     arg1=p;
  1489.     arg2=q;
  1490.     return(0);
  1491. }
  1492. struct blk *
  1493. removc(p,n)
  1494. struct blk *p;
  1495. {
  1496.     register struct blk *q,*r;
  1497.  
  1498.     rewind(p);
  1499.     while(n>1){
  1500.         sgetc(p);
  1501.         n -= 2;
  1502.     }
  1503.     q = salloc(2);
  1504.     while(sfeof(p) == 0)sputc(q,sgetc(p));
  1505.     if(n == 1){
  1506.         r = div(q,tenptr);
  1507.         release(q);
  1508.         release(rem);
  1509.         q = r;
  1510.     }
  1511.     release(p);
  1512.     return(q);
  1513. }
  1514. struct blk *
  1515. scalint(p)
  1516. struct blk *p;
  1517. {
  1518.     register int n;
  1519.     n = sunputc(p);
  1520.     p = removc(p,n);
  1521.     return(p);
  1522. }
  1523. struct blk *
  1524. scale(p,n)
  1525. struct blk *p;
  1526. {
  1527.     register struct blk *q,*s,*t;
  1528.  
  1529.     t = add0(p,n);
  1530.     q = salloc(1);
  1531.     sputc(q,n);
  1532.     s = exp(inbas,q);
  1533.     release(q);
  1534.     q = div(t,s);
  1535.     release(t);
  1536.     release(s);
  1537.     release(rem);
  1538.     sputc(q,n);
  1539.     return(q);
  1540. }
  1541. subt(){
  1542.     arg1=pop();
  1543.     EMPTYS;
  1544.     savk = sunputc(arg1);
  1545.     chsign(arg1);
  1546.     sputc(arg1,savk);
  1547.     pushp(arg1);
  1548.     if(eqk() != 0)return(1);
  1549.     binop('+');
  1550.     return(0);
  1551. }
  1552. command(){
  1553.     int c;
  1554.     char line[100],*sl;
  1555.     register (*savint)(),pid,rpid;
  1556.     int retcode;
  1557.  
  1558.     switch(c = readc()){
  1559.     case '<':
  1560.         return(cond(NL));
  1561.     case '>':
  1562.         return(cond(NG));
  1563.     case '=':
  1564.         return(cond(NE));
  1565.     default:
  1566.         sl = line;
  1567.         *sl++ = c;
  1568.         while((c = readc()) != '\n')*sl++ = c;
  1569.         *sl = 0;
  1570.         if((pid = fork()) == 0){
  1571.             execl("/bin/sh","sh","-c",line,0);
  1572.             exit(0100);
  1573.         }
  1574.         savint = signal(SIGINT, SIG_IGN);
  1575.         while((rpid = wait(&retcode)) != pid && rpid != -1);
  1576.         signal(SIGINT,savint);
  1577.         printf("!\n");
  1578.         return(0);
  1579.     }
  1580. }
  1581. cond(c)
  1582. char c;
  1583. {
  1584.     register struct blk *p;
  1585.     register char cc;
  1586.  
  1587.     if(subt() != 0)return(1);
  1588.     p = pop();
  1589.     sunputc(p);
  1590.     if(length(p) == 0){
  1591.         release(p);
  1592.         if(c == '<' || c == '>' || c == NE){
  1593.             readc();
  1594.             return(0);
  1595.         }
  1596.         load();
  1597.         return(1);
  1598.     }
  1599.     else {
  1600.         if(c == '='){
  1601.             release(p);
  1602.             readc();
  1603.             return(0);
  1604.         }
  1605.     }
  1606.     if(c == NE){
  1607.         release(p);
  1608.         load();
  1609.         return(1);
  1610.     }
  1611.     fsfile(p);
  1612.     cc = sbackc(p);
  1613.     release(p);
  1614.     if((cc<0 && (c == '<' || c == NG)) ||
  1615.         (cc >0) && (c == '>' || c == NL)){
  1616.         readc();
  1617.         return(0);
  1618.     }
  1619.     load();
  1620.     return(1);
  1621. }
  1622. load(){
  1623.     register int c;
  1624.     register struct blk *p,*q;
  1625.     struct blk *t,*s;
  1626.     c = readc() & 0377;
  1627.     sptr = stable[c];
  1628.     if(sptr != 0){
  1629.         p = sptr->val;
  1630.         if(c >= ARRAYST){
  1631.             q = salloc(length(p));
  1632.             rewind(p);
  1633.             while(sfeof(p) == 0){
  1634.                 s = getwd(p);
  1635.                 if(s == 0){putwd(q, (struct blk *)NULL);}
  1636.                 else{
  1637.                     t = copy(s,length(s));
  1638.                     putwd(q,t);
  1639.                 }
  1640.             }
  1641.             pushp(q);
  1642.         }
  1643.         else{
  1644.             q = copy(p,length(p));
  1645.             pushp(q);
  1646.         }
  1647.     }
  1648.     else{
  1649.         q = salloc(1);
  1650.         sputc(q,0);
  1651.         pushp(q);
  1652.     }
  1653.     return;
  1654. }
  1655. log2(n)
  1656. long n;
  1657. {
  1658.     register int i;
  1659.  
  1660.     if(n == 0)return(0);
  1661.     i=31;
  1662.     if(n<0)return(i);
  1663.     while((n= n<<1) >0)i--;
  1664.     return(--i);
  1665. }
  1666.  
  1667. struct blk *
  1668. salloc(size)
  1669. int size;
  1670. {
  1671.     register struct blk *hdr;
  1672.     register char *ptr;
  1673.     all++;
  1674.     nbytes += size;
  1675.     ptr = malloc((unsigned)size);
  1676.     if(ptr == 0){
  1677.         garbage("salloc");
  1678.         if((ptr = malloc((unsigned)size)) == 0)
  1679.             ospace("salloc");
  1680.     }
  1681.     if((hdr = hfree) == 0)hdr = morehd();
  1682.     hfree = (struct blk *)hdr->rd;
  1683.     hdr->rd = hdr->wt = hdr->beg = ptr;
  1684.     hdr->last = ptr+size;
  1685.     return(hdr);
  1686. }
  1687. struct blk *
  1688. morehd(){
  1689.     register struct blk *h,*kk;
  1690.     headmor++;
  1691.     nbytes += HEADSZ;
  1692.     hfree = h = (struct blk *)malloc(HEADSZ);
  1693.     if(hfree == 0){
  1694.         garbage("morehd");
  1695.         if((hfree = h = (struct blk *)malloc(HEADSZ)) == 0)
  1696.             ospace("headers");
  1697.     }
  1698.     kk = h;
  1699.     while(h<hfree+(HEADSZ/BLK))(h++)->rd = (char *)++kk;
  1700.     (--h)->rd=0;
  1701.     return(hfree);
  1702. }
  1703. /*
  1704. sunputc(hptr)
  1705. struct blk *hptr;
  1706. {
  1707.     hptr->wt--;
  1708.     hptr->rd = hptr->wt;
  1709.     return(*hptr->wt);
  1710. }
  1711. */
  1712. struct blk *
  1713. copy(hptr,size)
  1714. struct blk *hptr;
  1715. int size;
  1716. {
  1717.     register struct blk *hdr;
  1718.     register unsigned sz;
  1719.     register char *ptr;
  1720.  
  1721.     all++;
  1722.     nbytes += size;
  1723.     sz = length(hptr);
  1724.     ptr = nalloc(hptr->beg, (unsigned)size);
  1725.     if(ptr == 0){
  1726.         garbage("copy");
  1727.         if((ptr = nalloc(hptr->beg, (unsigned)size)) == NULL){
  1728.             printf("copy size %d\n",size);
  1729.             ospace("copy");
  1730.         }
  1731.     }
  1732.     if((hdr = hfree) == 0)hdr = morehd();
  1733.     hfree = (struct blk *)hdr->rd;
  1734.     hdr->rd = hdr->beg = ptr;
  1735.     hdr->last = ptr+size;
  1736.     hdr->wt = ptr+sz;
  1737.     ptr = hdr->wt;
  1738.     while(ptr<hdr->last)*ptr++ = '\0';
  1739.     return(hdr);
  1740. }
  1741. sdump(s1,hptr)
  1742. char *s1;
  1743. struct blk *hptr;
  1744. {
  1745.     char *p;
  1746.     printf("%s %o rd %o wt %o beg %o last %o\n",s1,hptr,hptr->rd,hptr->wt,hptr->beg,hptr->last);
  1747.     p = hptr->beg;
  1748.     while(p < hptr->wt)printf("%d ",*p++);
  1749.     printf("\n");
  1750. }
  1751. seekc(hptr,n)
  1752. struct blk *hptr;
  1753. {
  1754.     register char *nn,*p;
  1755.  
  1756.     nn = hptr->beg+n;
  1757.     if(nn > hptr->last){
  1758.         nbytes += nn - hptr->last;
  1759.         free(hptr->beg);
  1760.         p = realloc(hptr->beg, (unsigned)n);
  1761.         if(p == 0){
  1762.             hptr->beg = realloc(hptr->beg, (unsigned)(hptr->last-hptr->beg));
  1763.             garbage("seekc");
  1764.             if((p = realloc(hptr->beg, (unsigned)n)) == 0)
  1765.                 ospace("seekc");
  1766.         }
  1767.         hptr->beg = p;
  1768.         hptr->wt = hptr->last = hptr->rd = p+n;
  1769.         return;
  1770.     }
  1771.     hptr->rd = nn;
  1772.     if(nn>hptr->wt)hptr->wt = nn;
  1773.     return;
  1774. }
  1775. salterwd(hptr,n)
  1776. struct wblk *hptr;
  1777. struct blk *n;
  1778. {
  1779.     if(hptr->rdw == hptr->lastw)more(hptr);
  1780.     *hptr->rdw++ = n;
  1781.     if(hptr->rdw > hptr->wtw)hptr->wtw = hptr->rdw;
  1782.     return;
  1783. }
  1784. more(hptr)
  1785. struct blk *hptr;
  1786. {
  1787.     register unsigned size;
  1788.     register char *p;
  1789.  
  1790.     if((size=(hptr->last-hptr->beg)*2) == 0)size=1;
  1791.     nbytes += size/2;
  1792.     free(hptr->beg);
  1793.     p = realloc(hptr->beg, (unsigned)size);
  1794.     if(p == 0){
  1795.         hptr->beg = realloc(hptr->beg, (unsigned)(hptr->last-hptr->beg));
  1796.         garbage("more");
  1797.         if((p = realloc(hptr->beg,size)) == 0)
  1798.             ospace("more");
  1799.     }
  1800.     hptr->rd = hptr->rd-hptr->beg+p;
  1801.     hptr->wt = hptr->wt-hptr->beg+p;
  1802.     hptr->beg = p;
  1803.     hptr->last = p+size;
  1804.     return;
  1805. }
  1806. ospace(s)
  1807. char *s;
  1808. {
  1809.     printf("out of space: %s\n",s);
  1810.     printf("all %ld rel %ld headmor %ld\n",all,rel,headmor);
  1811.     printf("nbytes %ld\n",nbytes);
  1812.     sdump("stk",*stkptr);
  1813.     abort();
  1814. }
  1815. garbage(s)
  1816. char *s;
  1817. {
  1818.     int i;
  1819.     struct blk *p, *q;
  1820.     struct sym *tmps;
  1821.     int ct;
  1822.  
  1823. /*    printf("got to garbage %s\n",s);    */
  1824.     for(i=0;i<TBLSZ;i++){
  1825.         tmps = stable[i];
  1826.         if(tmps != 0){
  1827.             if(i < ARRAYST){
  1828.                 do {
  1829.                     p = tmps->val;
  1830.                     if(((int)p->beg & 01)  != 0){
  1831.                         printf("string %o\n",i);
  1832.                         sdump("odd beg",p);
  1833.                     }
  1834.                     redef(p);
  1835.                     tmps = tmps->next;
  1836.                 } while(tmps != 0);
  1837.                 continue;
  1838.             }
  1839.             else {
  1840.                 do {
  1841.                     p = tmps->val;
  1842.                     rewind(p);
  1843.                     ct = 0;
  1844.                     while((q = getwd(p)) != NULL){
  1845.                         ct++;
  1846.                         if(q != 0){
  1847.                             if(((int)q->beg & 01) != 0){
  1848.                                 printf("array %o elt %d odd\n",i-ARRAYST,ct);
  1849. printf("tmps %o p %o\n",tmps,p);
  1850.                                 sdump("elt",q);
  1851.                             }
  1852.                             redef(q);
  1853.                         }
  1854.                     }
  1855.                     tmps = tmps->next;
  1856.                 } while(tmps != 0);
  1857.             }
  1858.         }
  1859.     }
  1860. }
  1861. redef(p)
  1862. struct blk *p;
  1863. {
  1864.     register offset;
  1865.     register char *newp;
  1866.  
  1867.     if ((int)p->beg&01) {
  1868.         printf("odd ptr %o hdr %o\n",p->beg,p);
  1869.         ospace("redef-bad");
  1870.     }
  1871.     free(p->beg);
  1872.     free(dummy);
  1873.     dummy = malloc(1);
  1874.     if(dummy == NULL)ospace("dummy");
  1875.     newp = realloc(p->beg, (unsigned)(p->last-p->beg));
  1876.     if(newp == NULL)ospace("redef");
  1877.     offset = newp - p->beg;
  1878.     p->beg = newp;
  1879.     p->rd += offset;
  1880.     p->wt += offset;
  1881.     p->last += offset;
  1882. }
  1883.  
  1884. release(p)
  1885. register struct blk *p;
  1886. {
  1887.     rel++;
  1888.     nbytes -= p->last - p->beg;
  1889.     p->rd = (char *)hfree;
  1890.     hfree = p;
  1891.     free(p->beg);
  1892. }
  1893.  
  1894. struct blk *
  1895. getwd(p)
  1896. struct blk *p;
  1897. {
  1898.     register struct wblk *wp;
  1899.  
  1900.     wp = (struct wblk *)p;
  1901.     if (wp->rdw == wp->wtw)
  1902.         return(NULL);
  1903.     return(*wp->rdw++);
  1904. }
  1905.  
  1906. putwd(p, c)
  1907. struct blk *p, *c;
  1908. {
  1909.     register struct wblk *wp;
  1910.  
  1911.     wp = (struct wblk *)p;
  1912.     if (wp->wtw == wp->lastw)
  1913.         more(p);
  1914.     *wp->wtw++ = c;
  1915. }
  1916.  
  1917. struct blk *
  1918. lookwd(p)
  1919. struct blk *p;
  1920. {
  1921.     register struct wblk *wp;
  1922.  
  1923.     wp = (struct wblk *)p;
  1924.     if (wp->rdw == wp->wtw)
  1925.         return(NULL);
  1926.     return(*wp->rdw);
  1927. }
  1928. char *
  1929. nalloc(p,nbytes)
  1930. register char *p;
  1931. unsigned nbytes;
  1932. {
  1933.     char *malloc();
  1934.     register char *q, *r;
  1935.     q = r = malloc(nbytes);
  1936.     if(q==0)
  1937.         return(0);
  1938.     while(nbytes--)
  1939.         *q++ = *p++;
  1940.     return(r);
  1941. }
  1942.