+#ifndef lint
+static char sccsid[] = "@(#)dc.c 4.1 (Berkeley) %G%";
+#endif not lint
+
+#include <stdio.h>
+#include <signal.h>
+#include "dc.h"
+main(argc,argv)
+int argc;
+char *argv[];
+{
+ init(argc,argv);
+ commnds();
+}
+commnds(){
+ register int c;
+ register struct blk *p,*q;
+ long l;
+ int sign;
+ struct blk **ptr,*s,*t;
+ struct sym *sp;
+ int sk,sk1,sk2;
+ int n,d;
+
+ while(1){
+ if(((c = readc())>='0' && c <= '9')|| (c>='A' && c <='F') || c == '.'){
+ unreadc(c);
+ p = readin();
+ pushp(p);
+ continue;
+ }
+ switch(c){
+ case ' ':
+ case '\n':
+ case 0377:
+ case EOF:
+ continue;
+ case 'Y':
+ sdump("stk",*stkptr);
+ printf("all %ld rel %ld headmor %ld\n",all,rel,headmor);
+ printf("nbytes %ld\n",nbytes);
+ continue;
+ case '_':
+ p = readin();
+ savk = sunputc(p);
+ chsign(p);
+ sputc(p,savk);
+ pushp(p);
+ continue;
+ case '-':
+ subt();
+ continue;
+ case '+':
+ if(eqk() != 0)continue;
+ binop('+');
+ continue;
+ case '*':
+ arg1 = pop();
+ EMPTY;
+ arg2 = pop();
+ EMPTYR(arg1);
+ sk1 = sunputc(arg1);
+ sk2 = sunputc(arg2);
+ binop('*');
+ p = pop();
+ sunputc(p);
+ savk = sk1+sk2;
+ if(savk>k && savk>sk1 && savk>sk2){
+ sk = sk1;
+ if(sk<sk2)sk = sk2;
+ if(sk<k)sk = k;
+ p = removc(p,savk-sk);
+ savk = sk;
+ }
+ sputc(p,savk);
+ pushp(p);
+ continue;
+ case '/':
+casediv:
+ if(dscale() != 0)continue;
+ binop('/');
+ if(irem != 0)release(irem);
+ release(rem);
+ continue;
+ case '%':
+ if(dscale() != 0)continue;
+ binop('/');
+ p = pop();
+ release(p);
+ if(irem == 0){
+ sputc(rem,skr+k);
+ pushp(rem);
+ continue;
+ }
+ p = add0(rem,skd-(skr+k));
+ q = add(p,irem);
+ release(p);
+ release(irem);
+ sputc(q,skd);
+ pushp(q);
+ continue;
+ case 'v':
+ p = pop();
+ EMPTY;
+ savk = sunputc(p);
+ if(length(p) == 0){
+ sputc(p,savk);
+ pushp(p);
+ continue;
+ }
+ if((c = sbackc(p))<0){
+ error("sqrt of neg number\n");
+ }
+ if(k<savk)n = savk;
+ else{
+ n = k*2-savk;
+ savk = k;
+ }
+ arg1 = add0(p,n);
+ arg2 = sqrt(arg1);
+ sputc(arg2,savk);
+ pushp(arg2);
+ continue;
+ case '^':
+ neg = 0;
+ arg1 = pop();
+ EMPTY;
+ if(sunputc(arg1) != 0)error("exp not an integer\n");
+ arg2 = pop();
+ EMPTYR(arg1);
+ if(sfbeg(arg1) == 0 && sbackc(arg1)<0){
+ neg++;
+ chsign(arg1);
+ }
+ if(length(arg1)>=3){
+ error("exp too big\n");
+ }
+ savk = sunputc(arg2);
+ p = exp(arg2,arg1);
+ release(arg2);
+ rewind(arg1);
+ c = sgetc(arg1);
+ if(sfeof(arg1) == 0)
+ c = sgetc(arg1)*100 + c;
+ d = c*savk;
+ release(arg1);
+ if(neg == 0){
+ if(k>=savk)n = k;
+ else n = savk;
+ if(n<d){
+ q = removc(p,d-n);
+ sputc(q,n);
+ pushp(q);
+ }
+ else {
+ sputc(p,d);
+ pushp(p);
+ }
+ }
+ else {
+ sputc(p,d);
+ pushp(p);
+ }
+ if(neg == 0)continue;
+ p = pop();
+ q = salloc(2);
+ sputc(q,1);
+ sputc(q,0);
+ pushp(q);
+ pushp(p);
+ goto casediv;
+ case 'z':
+ p = salloc(2);
+ n = stkptr - stkbeg;
+ if(n >= 100){
+ sputc(p,n/100);
+ n %= 100;
+ }
+ sputc(p,n);
+ sputc(p,0);
+ pushp(p);
+ continue;
+ case 'Z':
+ p = pop();
+ EMPTY;
+ n = (length(p)-1)<<1;
+ fsfile(p);
+ sbackc(p);
+ if(sfbeg(p) == 0){
+ if((c = sbackc(p))<0){
+ n -= 2;
+ if(sfbeg(p) == 1)n += 1;
+ else {
+ if((c = sbackc(p)) == 0)n += 1;
+ else if(c > 90)n -= 1;
+ }
+ }
+ else if(c < 10) n -= 1;
+ }
+ release(p);
+ q = salloc(1);
+ if(n >= 100){
+ sputc(q,n%100);
+ n /= 100;
+ }
+ sputc(q,n);
+ sputc(q,0);
+ pushp(q);
+ continue;
+ case 'i':
+ p = pop();
+ EMPTY;
+ p = scalint(p);
+ release(inbas);
+ inbas = p;
+ continue;
+ case 'I':
+ p = copy(inbas,length(inbas)+1);
+ sputc(p,0);
+ pushp(p);
+ continue;
+ case 'o':
+ p = pop();
+ EMPTY;
+ p = scalint(p);
+ sign = 0;
+ n = length(p);
+ q = copy(p,n);
+ fsfile(q);
+ l = c = sbackc(q);
+ if(n != 1){
+ if(c<0){
+ sign = 1;
+ chsign(q);
+ n = length(q);
+ fsfile(q);
+ l = c = sbackc(q);
+ }
+ if(n != 1){
+ while(sfbeg(q) == 0)l = l*100+sbackc(q);
+ }
+ }
+ logo = log2(l);
+ obase = l;
+ release(basptr);
+ if(sign == 1)obase = -l;
+ basptr = p;
+ outdit = bigot;
+ if(n == 1 && sign == 0){
+ if(c <= 16){
+ outdit = hexot;
+ fw = 1;
+ fw1 = 0;
+ ll = 70;
+ release(q);
+ continue;
+ }
+ }
+ n = 0;
+ if(sign == 1)n++;
+ p = salloc(1);
+ sputc(p,-1);
+ t = add(p,q);
+ n += length(t)*2;
+ fsfile(t);
+ if((c = sbackc(t))>9)n++;
+ release(t);
+ release(q);
+ release(p);
+ fw = n;
+ fw1 = n-1;
+ ll = 70;
+ if(fw>=ll)continue;
+ ll = (70/fw)*fw;
+ continue;
+ case 'O':
+ p = copy(basptr,length(basptr)+1);
+ sputc(p,0);
+ pushp(p);
+ continue;
+ case '[':
+ n = 0;
+ p = salloc(0);
+ while(1){
+ if((c = readc()) == ']'){
+ if(n == 0)break;
+ n--;
+ }
+ sputc(p,c);
+ if(c == '[')n++;
+ }
+ pushp(p);
+ continue;
+ case 'k':
+ p = pop();
+ EMPTY;
+ p = scalint(p);
+ if(length(p)>1){
+ error("scale too big\n");
+ }
+ rewind(p);
+ k = sfeof(p)?0:sgetc(p);
+ release(scalptr);
+ scalptr = p;
+ continue;
+ case 'K':
+ p = copy(scalptr,length(scalptr)+1);
+ sputc(p,0);
+ pushp(p);
+ continue;
+ case 'X':
+ p = pop();
+ EMPTY;
+ fsfile(p);
+ n = sbackc(p);
+ release(p);
+ p = salloc(2);
+ sputc(p,n);
+ sputc(p,0);
+ pushp(p);
+ continue;
+ case 'Q':
+ p = pop();
+ EMPTY;
+ if(length(p)>2){
+ error("Q?\n");
+ }
+ rewind(p);
+ if((c = sgetc(p))<0){
+ error("neg Q\n");
+ }
+ release(p);
+ while(c-- > 0){
+ if(readptr == &readstk[0]){
+ error("readstk?\n");
+ }
+ if(*readptr != 0)release(*readptr);
+ readptr--;
+ }
+ continue;
+ case 'q':
+ if(readptr <= &readstk[1])exit(0);
+ if(*readptr != 0)release(*readptr);
+ readptr--;
+ if(*readptr != 0)release(*readptr);
+ readptr--;
+ continue;
+ case 'f':
+ if(stkptr == &stack[0])printf("empty stack\n");
+ else {
+ for(ptr = stkptr; ptr > &stack[0];){
+ print(*ptr--);
+ }
+ }
+ continue;
+ case 'p':
+ if(stkptr == &stack[0])printf("empty stack\n");
+ else{
+ print(*stkptr);
+ }
+ continue;
+ case 'P':
+ p = pop();
+ EMPTY;
+ sputc(p,0);
+ printf("%s",p->beg);
+ release(p);
+ continue;
+ case 'd':
+ if(stkptr == &stack[0]){
+ printf("empty stack\n");
+ continue;
+ }
+ q = *stkptr;
+ n = length(q);
+ p = copy(*stkptr,n);
+ pushp(p);
+ continue;
+ case 'c':
+ while(stkerr == 0){
+ p = pop();
+ if(stkerr == 0)release(p);
+ }
+ continue;
+ case 'S':
+ if(stkptr == &stack[0]){
+ error("save: args\n");
+ }
+ c = readc() & 0377;
+ sptr = stable[c];
+ sp = stable[c] = sfree;
+ sfree = sfree->next;
+ if(sfree == 0)goto sempty;
+ sp->next = sptr;
+ p = pop();
+ EMPTY;
+ if(c >= ARRAYST){
+ q = copy(p,PTRSZ);
+ for(n = 0;n < PTRSZ-1;n++)sputc(q,0);
+ release(p);
+ p = q;
+ }
+ sp->val = p;
+ continue;
+sempty:
+ error("symbol table overflow\n");
+ case 's':
+ if(stkptr == &stack[0]){
+ error("save:args\n");
+ }
+ c = readc() & 0377;
+ sptr = stable[c];
+ if(sptr != 0){
+ p = sptr->val;
+ if(c >= ARRAYST){
+ rewind(p);
+ while(sfeof(p) == 0)release(getwd(p));
+ }
+ release(p);
+ }
+ else{
+ sptr = stable[c] = sfree;
+ sfree = sfree->next;
+ if(sfree == 0)goto sempty;
+ sptr->next = 0;
+ }
+ p = pop();
+ sptr->val = p;
+ continue;
+ case 'l':
+ load();
+ continue;
+ case 'L':
+ c = readc() & 0377;
+ sptr = stable[c];
+ if(sptr == 0){
+ error("L?\n");
+ }
+ stable[c] = sptr->next;
+ sptr->next = sfree;
+ sfree = sptr;
+ p = sptr->val;
+ if(c >= ARRAYST){
+ rewind(p);
+ while(sfeof(p) == 0){
+ q = getwd(p);
+ if(q != 0)release(q);
+ }
+ }
+ pushp(p);
+ continue;
+ case ':':
+ p = pop();
+ EMPTY;
+ q = scalint(p);
+ fsfile(q);
+ c = 0;
+ if((sfbeg(q) == 0) && ((c = sbackc(q))<0)){
+ error("neg index\n");
+ }
+ if(length(q)>2){
+ error("index too big\n");
+ }
+ if(sfbeg(q) == 0)c = c*100+sbackc(q);
+ if(c >= MAXIND){
+ error("index too big\n");
+ }
+ release(q);
+ n = readc() & 0377;
+ sptr = stable[n];
+ if(sptr == 0){
+ sptr = stable[n] = sfree;
+ sfree = sfree->next;
+ if(sfree == 0)goto sempty;
+ sptr->next = 0;
+ p = salloc((c+PTRSZ)*PTRSZ);
+ zero(p);
+ }
+ else{
+ p = sptr->val;
+ if(length(p)-PTRSZ < c*PTRSZ){
+ q = copy(p,(c+PTRSZ)*PTRSZ);
+ release(p);
+ p = q;
+ }
+ }
+ seekc(p,c*PTRSZ);
+ q = lookwd(p);
+ if (q!=NULL) release(q);
+ s = pop();
+ EMPTY;
+ salterwd(p,s);
+ sptr->val = p;
+ continue;
+ case ';':
+ p = pop();
+ EMPTY;
+ q = scalint(p);
+ fsfile(q);
+ c = 0;
+ if((sfbeg(q) == 0) && ((c = sbackc(q))<0)){
+ error("neg index\n");
+ }
+ if(length(q)>2){
+ error("index too big\n");
+ }
+ if(sfbeg(q) == 0)c = c*100+sbackc(q);
+ if(c >= MAXIND){
+ error("index too big\n");
+ }
+ release(q);
+ n = readc() & 0377;
+ sptr = stable[n];
+ if(sptr != 0){
+ p = sptr->val;
+ if(length(p)-PTRSZ >= c*PTRSZ){
+ seekc(p,c*PTRSZ);
+ s = getwd(p);
+ if(s != 0){
+ q = copy(s,length(s));
+ pushp(q);
+ continue;
+ }
+ }
+ }
+ q = salloc(PTRSZ);
+ putwd(q, (struct blk *)0);
+ pushp(q);
+ continue;
+ case 'x':
+execute:
+ p = pop();
+ EMPTY;
+ if((readptr != &readstk[0]) && (*readptr != 0)){
+ if((*readptr)->rd == (*readptr)->wt)
+ release(*readptr);
+ else{
+ if(readptr++ == &readstk[RDSKSZ]){
+ error("nesting depth\n");
+ }
+ }
+ }
+ else readptr++;
+ *readptr = p;
+ if(p != 0)rewind(p);
+ else{
+ if((c = readc()) != '\n')unreadc(c);
+ }
+ continue;
+ case '?':
+ if(++readptr == &readstk[RDSKSZ]){
+ error("nesting depth\n");
+ }
+ *readptr = 0;
+ fsave = curfile;
+ curfile = stdin;
+ while((c = readc()) == '!')command();
+ p = salloc(0);
+ sputc(p,c);
+ while((c = readc()) != '\n'){
+ sputc(p,c);
+ if(c == '\\')sputc(p,readc());
+ }
+ curfile = fsave;
+ *readptr = p;
+ continue;
+ case '!':
+ if(command() == 1)goto execute;
+ continue;
+ case '<':
+ case '>':
+ case '=':
+ if(cond(c) == 1)goto execute;
+ continue;
+ default:
+ printf("%o is unimplemented\n",c);
+ }
+ }
+}
+struct blk *
+div(ddivd,ddivr)
+struct blk *ddivd,*ddivr;
+{
+ int divsign,remsign,offset,divcarry;
+ int carry, dig,magic,d,dd;
+ long c,td,cc;
+ struct blk *ps;
+ register struct blk *p,*divd,*divr;
+
+ rem = 0;
+ p = salloc(0);
+ if(length(ddivr) == 0){
+ pushp(ddivr);
+ errorrt("divide by 0\n");
+ }
+ divsign = remsign = 0;
+ divr = ddivr;
+ fsfile(divr);
+ if(sbackc(divr) == -1){
+ divr = copy(ddivr,length(ddivr));
+ chsign(divr);
+ divsign = ~divsign;
+ }
+ divd = copy(ddivd,length(ddivd));
+ fsfile(divd);
+ if(sfbeg(divd) == 0 && sbackc(divd) == -1){
+ chsign(divd);
+ divsign = ~divsign;
+ remsign = ~remsign;
+ }
+ offset = length(divd) - length(divr);
+ if(offset < 0)goto ddone;
+ seekc(p,offset+1);
+ sputc(divd,0);
+ magic = 0;
+ fsfile(divr);
+ c = sbackc(divr);
+ if(c<10)magic++;
+ c = c*100 + (sfbeg(divr)?0:sbackc(divr));
+ if(magic>0){
+ c = (c*100 +(sfbeg(divr)?0:sbackc(divr)))*2;
+ c /= 25;
+ }
+ while(offset >= 0){
+ fsfile(divd);
+ td = sbackc(divd)*100;
+ dd = sfbeg(divd)?0:sbackc(divd);
+ td = (td+dd)*100;
+ dd = sfbeg(divd)?0:sbackc(divd);
+ td = td+dd;
+ cc = c;
+ if(offset == 0)td += 1;
+ else cc += 1;
+ if(magic != 0)td = td<<3;
+ dig = td/cc;
+ rewind(divr);
+ rewind(divxyz);
+ carry = 0;
+ while(sfeof(divr) == 0){
+ d = sgetc(divr)*dig+carry;
+ carry = d / 100;
+ salterc(divxyz,d%100);
+ }
+ salterc(divxyz,carry);
+ rewind(divxyz);
+ seekc(divd,offset);
+ carry = 0;
+ while(sfeof(divd) == 0){
+ d = slookc(divd);
+ d = d-(sfeof(divxyz)?0:sgetc(divxyz))-carry;
+ carry = 0;
+ if(d < 0){
+ d += 100;
+ carry = 1;
+ }
+ salterc(divd,d);
+ }
+ divcarry = carry;
+ sbackc(p);
+ salterc(p,dig);
+ sbackc(p);
+ if(--offset >= 0)divd->wt--;
+ }
+ if(divcarry != 0){
+ salterc(p,dig-1);
+ salterc(divd,-1);
+ ps = add(divr,divd);
+ release(divd);
+ divd = ps;
+ }
+
+ rewind(p);
+ divcarry = 0;
+ while(sfeof(p) == 0){
+ d = slookc(p)+divcarry;
+ divcarry = 0;
+ if(d >= 100){
+ d -= 100;
+ divcarry = 1;
+ }
+ salterc(p,d);
+ }
+ if(divcarry != 0)salterc(p,divcarry);
+ fsfile(p);
+ while(sfbeg(p) == 0){
+ if(sbackc(p) == 0)truncate(p);
+ else break;
+ }
+ if(divsign < 0)chsign(p);
+ fsfile(divd);
+ while(sfbeg(divd) == 0){
+ if(sbackc(divd) == 0)truncate(divd);
+ else break;
+ }
+ddone:
+ if(remsign<0)chsign(divd);
+ if(divr != ddivr)release(divr);
+ rem = divd;
+ return(p);
+}
+dscale(){
+ register struct blk *dd,*dr;
+ register struct blk *r;
+ int c;
+
+ dr = pop();
+ EMPTYS;
+ dd = pop();
+ EMPTYSR(dr);
+ fsfile(dd);
+ skd = sunputc(dd);
+ fsfile(dr);
+ skr = sunputc(dr);
+ if(sfbeg(dr) == 1 || (sfbeg(dr) == 0 && sbackc(dr) == 0)){
+ sputc(dr,skr);
+ pushp(dr);
+ errorrt("divide by 0\n");
+ }
+ c = k-skd+skr;
+ if(c < 0)r = removr(dd,-c);
+ else {
+ r = add0(dd,c);
+ irem = 0;
+ }
+ arg1 = r;
+ arg2 = dr;
+ savk = k;
+ return(0);
+}
+struct blk *
+removr(p,n)
+struct blk *p;
+{
+ int nn;
+ register struct blk *q,*s,*r;
+
+ rewind(p);
+ nn = (n+1)/2;
+ q = salloc(nn);
+ while(n>1){
+ sputc(q,sgetc(p));
+ n -= 2;
+ }
+ r = salloc(2);
+ while(sfeof(p) == 0)sputc(r,sgetc(p));
+ release(p);
+ if(n == 1){
+ s = div(r,tenptr);
+ release(r);
+ rewind(rem);
+ if(sfeof(rem) == 0)sputc(q,sgetc(rem));
+ release(rem);
+ irem = q;
+ return(s);
+ }
+ irem = q;
+ return(r);
+}
+struct blk *
+sqrt(p)
+struct blk *p;
+{
+ struct blk *t;
+ struct blk *r,*q,*s;
+ int c,n,nn;
+
+ n = length(p);
+ fsfile(p);
+ c = sbackc(p);
+ if((n&1) != 1)c = c*100+(sfbeg(p)?0:sbackc(p));
+ n = (n+1)>>1;
+ r = salloc(n);
+ zero(r);
+ seekc(r,n);
+ nn=1;
+ while((c -= nn)>=0)nn+=2;
+ c=(nn+1)>>1;
+ fsfile(r);
+ sbackc(r);
+ if(c>=100){
+ c -= 100;
+ salterc(r,c);
+ sputc(r,1);
+ }
+ else salterc(r,c);
+ while(1){
+ q = div(p,r);
+ s = add(q,r);
+ release(q);
+ release(rem);
+ q = div(s,sqtemp);
+ release(s);
+ release(rem);
+ s = copy(r,length(r));
+ chsign(s);
+ t = add(s,q);
+ release(s);
+ fsfile(t);
+ nn = sfbeg(t)?0:sbackc(t);
+ if(nn>=0)break;
+ release(r);
+ release(t);
+ r = q;
+ }
+ release(t);
+ release(q);
+ release(p);
+ return(r);
+}
+struct blk *
+exp(base,ex)
+struct blk *base,*ex;
+{
+ register struct blk *r,*e,*p;
+ struct blk *e1,*t,*cp;
+ int temp,c,n;
+ r = salloc(1);
+ sputc(r,1);
+ p = copy(base,length(base));
+ e = copy(ex,length(ex));
+ fsfile(e);
+ if(sfbeg(e) != 0)goto edone;
+ temp=0;
+ c = sbackc(e);
+ if(c<0){
+ temp++;
+ chsign(e);
+ }
+ while(length(e) != 0){
+ e1=div(e,sqtemp);
+ release(e);
+ e = e1;
+ n = length(rem);
+ release(rem);
+ if(n != 0){
+ e1=mult(p,r);
+ release(r);
+ r = e1;
+ }
+ t = copy(p,length(p));
+ cp = mult(p,t);
+ release(p);
+ release(t);
+ p = cp;
+ }
+ if(temp != 0){
+ if((c = length(base)) == 0){
+ goto edone;
+ }
+ if(c>1)create(r);
+ else{
+ rewind(base);
+ if((c = sgetc(base))<=1){
+ create(r);
+ sputc(r,c);
+ }
+ else create(r);
+ }
+ }
+edone:
+ release(p);
+ release(e);
+ return(r);
+}
+init(argc,argv)
+int argc;
+char *argv[];
+{
+ register struct sym *sp;
+
+ if (signal(SIGINT, SIG_IGN) != SIG_IGN)
+ signal(SIGINT,onintr);
+ setbuf(stdout,(char *)NULL);
+ svargc = --argc;
+ svargv = argv;
+ while(svargc>0 && svargv[1][0] == '-'){
+ switch(svargv[1][1]){
+ default:
+ dbg=1;
+ }
+ svargc--;
+ svargv++;
+ }
+ ifile=1;
+ if(svargc<=0)curfile = stdin;
+ else if((curfile = fopen(svargv[1],"r")) == NULL){
+ printf("can't open file %s\n",svargv[1]);
+ exit(1);
+ }
+ dummy = malloc(1);
+ scalptr = salloc(1);
+ sputc(scalptr,0);
+ basptr = salloc(1);
+ sputc(basptr,10);
+ obase=10;
+ log10=log2(10L);
+ ll=70;
+ fw=1;
+ fw1=0;
+ tenptr = salloc(1);
+ sputc(tenptr,10);
+ obase=10;
+ inbas = salloc(1);
+ sputc(inbas,10);
+ sqtemp = salloc(1);
+ sputc(sqtemp,2);
+ chptr = salloc(0);
+ strptr = salloc(0);
+ divxyz = salloc(0);
+ stkbeg = stkptr = &stack[0];
+ stkend = &stack[STKSZ];
+ stkerr = 0;
+ readptr = &readstk[0];
+ k=0;
+ sp = sptr = &symlst[0];
+ while(sptr < &symlst[TBLSZ]){
+ sptr->next = ++sp;
+ sptr++;
+ }
+ sptr->next=0;
+ sfree = &symlst[0];
+ return;
+}
+onintr(){
+
+ signal(SIGINT,onintr);
+ while(readptr != &readstk[0]){
+ if(*readptr != 0){release(*readptr);}
+ readptr--;
+ }
+ curfile = stdin;
+ commnds();
+}
+pushp(p)
+struct blk *p;
+{
+ if(stkptr == stkend){
+ printf("out of stack space\n");
+ return;
+ }
+ stkerr=0;
+ *++stkptr = p;
+ return;
+}
+struct blk *
+pop(){
+ if(stkptr == stack){
+ stkerr=1;
+ return(0);
+ }
+ return(*stkptr--);
+}
+struct blk *
+readin(){
+ register struct blk *p,*q;
+ int dp,dpct;
+ register int c;
+
+ dp = dpct=0;
+ p = salloc(0);
+ while(1){
+ c = readc();
+ switch(c){
+ case '.':
+ if(dp != 0){
+ unreadc(c);
+ break;
+ }
+ dp++;
+ continue;
+ case '\\':
+ readc();
+ continue;
+ default:
+ if(c >= 'A' && c <= 'F')c = c - 'A' + 10;
+ else if(c >= '0' && c <= '9')c -= '0';
+ else goto gotnum;
+ if(dp != 0){
+ if(dpct >= 99)continue;
+ dpct++;
+ }
+ create(chptr);
+ if(c != 0)sputc(chptr,c);
+ q = mult(p,inbas);
+ release(p);
+ p = add(chptr,q);
+ release(q);
+ }
+ }
+gotnum:
+ unreadc(c);
+ if(dp == 0){
+ sputc(p,0);
+ return(p);
+ }
+ else{
+ q = scale(p,dpct);
+ return(q);
+ }
+}
+struct blk *
+add0(p,ct)
+int ct;
+struct blk *p;
+{
+ /* returns pointer to struct with ct 0's & p */
+ register struct blk *q,*t;
+
+ q = salloc(length(p)+(ct+1)/2);
+ while(ct>1){
+ sputc(q,0);
+ ct -= 2;
+ }
+ rewind(p);
+ while(sfeof(p) == 0){
+ sputc(q,sgetc(p));
+ }
+ release(p);
+ if(ct == 1){
+ t = mult(tenptr,q);
+ release(q);
+ return(t);
+ }
+ return(q);
+}
+struct blk *
+mult(p,q)
+struct blk *p,*q;
+{
+ register struct blk *mp,*mq,*mr;
+ int sign,offset,carry;
+ int cq,cp,mt,mcr;
+
+ offset = sign = 0;
+ fsfile(p);
+ mp = p;
+ if(sfbeg(p) == 0){
+ if(sbackc(p)<0){
+ mp = copy(p,length(p));
+ chsign(mp);
+ sign = ~sign;
+ }
+ }
+ fsfile(q);
+ mq = q;
+ if(sfbeg(q) == 0){
+ if(sbackc(q)<0){
+ mq = copy(q,length(q));
+ chsign(mq);
+ sign = ~sign;
+ }
+ }
+ mr = salloc(length(mp)+length(mq));
+ zero(mr);
+ rewind(mq);
+ while(sfeof(mq) == 0){
+ cq = sgetc(mq);
+ rewind(mp);
+ rewind(mr);
+ mr->rd += offset;
+ carry=0;
+ while(sfeof(mp) == 0){
+ cp = sgetc(mp);
+ mcr = sfeof(mr)?0:slookc(mr);
+ mt = cp*cq + carry + mcr;
+ carry = mt/100;
+ salterc(mr,mt%100);
+ }
+ offset++;
+ if(carry != 0){
+ mcr = sfeof(mr)?0:slookc(mr);
+ salterc(mr,mcr+carry);
+ }
+ }
+ if(sign < 0){
+ chsign(mr);
+ }
+ if(mp != p)release(mp);
+ if(mq != q)release(mq);
+ return(mr);
+}
+chsign(p)
+struct blk *p;
+{
+ register int carry;
+ register char ct;
+
+ carry=0;
+ rewind(p);
+ while(sfeof(p) == 0){
+ ct=100-slookc(p)-carry;
+ carry=1;
+ if(ct>=100){
+ ct -= 100;
+ carry=0;
+ }
+ salterc(p,ct);
+ }
+ if(carry != 0){
+ sputc(p,-1);
+ fsfile(p);
+ sbackc(p);
+ ct = sbackc(p);
+ if(ct == 99){
+ truncate(p);
+ sputc(p,-1);
+ }
+ }
+ else{
+ fsfile(p);
+ ct = sbackc(p);
+ if(ct == 0)truncate(p);
+ }
+ return;
+}
+readc(){
+loop:
+ if((readptr != &readstk[0]) && (*readptr != 0)){
+ if(sfeof(*readptr) == 0)return(lastchar = sgetc(*readptr));
+ release(*readptr);
+ readptr--;
+ goto loop;
+ }
+ lastchar = getc(curfile);
+ if(lastchar != EOF)return(lastchar);
+ if(readptr != &readptr[0]){
+ readptr--;
+ if(*readptr == 0)curfile = stdin;
+ goto loop;
+ }
+ if(curfile != stdin){
+ fclose(curfile);
+ curfile = stdin;
+ goto loop;
+ }
+ exit(0);
+}
+unreadc(c)
+char c;
+{
+
+ if((readptr != &readstk[0]) && (*readptr != 0)){
+ sungetc(*readptr,c);
+ }
+ else ungetc(c,curfile);
+ return;
+}
+binop(c)
+char c;
+{
+ register struct blk *r;
+
+ switch(c){
+ case '+':
+ r = add(arg1,arg2);
+ break;
+ case '*':
+ r = mult(arg1,arg2);
+ break;
+ case '/':
+ r = div(arg1,arg2);
+ break;
+ }
+ release(arg1);
+ release(arg2);
+ sputc(r,savk);
+ pushp(r);
+ return;
+}
+print(hptr)
+struct blk *hptr;
+{
+ int sc;
+ register struct blk *p,*q,*dec;
+ int dig,dout,ct;
+
+ rewind(hptr);
+ while(sfeof(hptr) == 0){
+ if(sgetc(hptr)>99){
+ rewind(hptr);
+ while(sfeof(hptr) == 0){
+ printf("%c",sgetc(hptr));
+ }
+ printf("\n");
+ return;
+ }
+ }
+ fsfile(hptr);
+ sc = sbackc(hptr);
+ if(sfbeg(hptr) != 0){
+ printf("0\n");
+ return;
+ }
+ count = ll;
+ p = copy(hptr,length(hptr));
+ sunputc(p);
+ fsfile(p);
+ if(sbackc(p)<0){
+ chsign(p);
+ OUTC('-');
+ }
+ if((obase == 0) || (obase == -1)){
+ oneot(p,sc,'d');
+ return;
+ }
+ if(obase == 1){
+ oneot(p,sc,'1');
+ return;
+ }
+ if(obase == 10){
+ tenot(p,sc);
+ return;
+ }
+ create(strptr);
+ dig = log10*sc;
+ dout = ((dig/10) + dig) /logo;
+ dec = getdec(p,sc);
+ p = removc(p,sc);
+ while(length(p) != 0){
+ q = div(p,basptr);
+ release(p);
+ p = q;
+ (*outdit)(rem,0);
+ }
+ release(p);
+ fsfile(strptr);
+ while(sfbeg(strptr) == 0)OUTC(sbackc(strptr));
+ if(sc == 0){
+ release(dec);
+ printf("\n");
+ return;
+ }
+ create(strptr);
+ OUTC('.');
+ ct=0;
+ do{
+ q = mult(basptr,dec);
+ release(dec);
+ dec = getdec(q,sc);
+ p = removc(q,sc);
+ (*outdit)(p,1);
+ }while(++ct < dout);
+ release(dec);
+ rewind(strptr);
+ while(sfeof(strptr) == 0)OUTC(sgetc(strptr));
+ printf("\n");
+ return;
+}
+
+struct blk *
+getdec(p,sc)
+struct blk *p;
+{
+ int cc;
+ register struct blk *q,*t,*s;
+
+ rewind(p);
+ if(length(p)*2 < sc){
+ q = copy(p,length(p));
+ return(q);
+ }
+ q = salloc(length(p));
+ while(sc >= 1){
+ sputc(q,sgetc(p));
+ sc -= 2;
+ }
+ if(sc != 0){
+ t = mult(q,tenptr);
+ s = salloc(cc = length(q));
+ release(q);
+ rewind(t);
+ while(cc-- > 0)sputc(s,sgetc(t));
+ sputc(s,0);
+ release(t);
+ t = div(s,tenptr);
+ release(s);
+ release(rem);
+ return(t);
+ }
+ return(q);
+}
+tenot(p,sc)
+struct blk *p;
+{
+ register int c,f;
+
+ fsfile(p);
+ f=0;
+ while((sfbeg(p) == 0) && ((p->rd-p->beg-1)*2 >= sc)){
+ c = sbackc(p);
+ if((c<10) && (f == 1))printf("0%d",c);
+ else printf("%d",c);
+ f=1;
+ TEST2;
+ }
+ if(sc == 0){
+ printf("\n");
+ release(p);
+ return;
+ }
+ if((p->rd-p->beg)*2 > sc){
+ c = sbackc(p);
+ printf("%d.",c/10);
+ TEST2;
+ OUTC(c%10 +'0');
+ sc--;
+ }
+ else {
+ OUTC('.');
+ }
+ if(sc > (p->rd-p->beg)*2){
+ while(sc>(p->rd-p->beg)*2){
+ OUTC('0');
+ sc--;
+ }
+ }
+ while(sc > 1){
+ c = sbackc(p);
+ if(c<10)printf("0%d",c);
+ else printf("%d",c);
+ sc -= 2;
+ TEST2;
+ }
+ if(sc == 1){
+ OUTC(sbackc(p)/10 +'0');
+ }
+ printf("\n");
+ release(p);
+ return;
+}
+oneot(p,sc,ch)
+struct blk *p;
+char ch;
+{
+ register struct blk *q;
+
+ q = removc(p,sc);
+ create(strptr);
+ sputc(strptr,-1);
+ while(length(q)>0){
+ p = add(strptr,q);
+ release(q);
+ q = p;
+ OUTC(ch);
+ }
+ release(q);
+ printf("\n");
+ return;
+}
+hexot(p,flg)
+struct blk *p;
+{
+ register int c;
+ rewind(p);
+ if(sfeof(p) != 0){
+ sputc(strptr,'0');
+ release(p);
+ return;
+ }
+ c = sgetc(p);
+ release(p);
+ if(c >= 16){
+ printf("hex digit > 16");
+ return;
+ }
+ sputc(strptr,c<10?c+'0':c-10+'A');
+ return;
+}
+bigot(p,flg)
+struct blk *p;
+{
+ register struct blk *t,*q;
+ register int l;
+ int neg;
+
+ if(flg == 1)t = salloc(0);
+ else{
+ t = strptr;
+ l = length(strptr)+fw-1;
+ }
+ neg=0;
+ if(length(p) != 0){
+ fsfile(p);
+ if(sbackc(p)<0){
+ neg=1;
+ chsign(p);
+ }
+ while(length(p) != 0){
+ q = div(p,tenptr);
+ release(p);
+ p = q;
+ rewind(rem);
+ sputc(t,sfeof(rem)?'0':sgetc(rem)+'0');
+ release(rem);
+ }
+ }
+ release(p);
+ if(flg == 1){
+ l = fw1-length(t);
+ if(neg != 0){
+ l--;
+ sputc(strptr,'-');
+ }
+ fsfile(t);
+ while(l-- > 0)sputc(strptr,'0');
+ while(sfbeg(t) == 0)sputc(strptr,sbackc(t));
+ release(t);
+ }
+ else{
+ l -= length(strptr);
+ while(l-- > 0)sputc(strptr,'0');
+ if(neg != 0){
+ sunputc(strptr);
+ sputc(strptr,'-');
+ }
+ }
+ sputc(strptr,' ');
+ return;
+}
+struct blk *
+add(a1,a2)
+struct blk *a1,*a2;
+{
+ register struct blk *p;
+ register int carry,n;
+ int size;
+ int c,n1,n2;
+
+ size = length(a1)>length(a2)?length(a1):length(a2);
+ p = salloc(size);
+ rewind(a1);
+ rewind(a2);
+ carry=0;
+ while(--size >= 0){
+ n1 = sfeof(a1)?0:sgetc(a1);
+ n2 = sfeof(a2)?0:sgetc(a2);
+ n = n1 + n2 + carry;
+ if(n>=100){
+ carry=1;
+ n -= 100;
+ }
+ else if(n<0){
+ carry = -1;
+ n += 100;
+ }
+ else carry = 0;
+ sputc(p,n);
+ }
+ if(carry != 0)sputc(p,carry);
+ fsfile(p);
+ if(sfbeg(p) == 0){
+ while(sfbeg(p) == 0 && (c = sbackc(p)) == 0);
+ if(c != 0)salterc(p,c);
+ truncate(p);
+ }
+ fsfile(p);
+ if(sfbeg(p) == 0 && sbackc(p) == -1){
+ while((c = sbackc(p)) == 99){
+ if(c == EOF)break;
+ }
+ sgetc(p);
+ salterc(p,-1);
+ truncate(p);
+ }
+ return(p);
+}
+eqk(){
+ register struct blk *p,*q;
+ register int skp;
+ int skq;
+
+ p = pop();
+ EMPTYS;
+ q = pop();
+ EMPTYSR(p);
+ skp = sunputc(p);
+ skq = sunputc(q);
+ if(skp == skq){
+ arg1=p;
+ arg2=q;
+ savk = skp;
+ return(0);
+ }
+ else if(skp < skq){
+ savk = skq;
+ p = add0(p,skq-skp);
+ }
+ else {
+ savk = skp;
+ q = add0(q,skp-skq);
+ }
+ arg1=p;
+ arg2=q;
+ return(0);
+}
+struct blk *
+removc(p,n)
+struct blk *p;
+{
+ register struct blk *q,*r;
+
+ rewind(p);
+ while(n>1){
+ sgetc(p);
+ n -= 2;
+ }
+ q = salloc(2);
+ while(sfeof(p) == 0)sputc(q,sgetc(p));
+ if(n == 1){
+ r = div(q,tenptr);
+ release(q);
+ release(rem);
+ q = r;
+ }
+ release(p);
+ return(q);
+}
+struct blk *
+scalint(p)
+struct blk *p;
+{
+ register int n;
+ n = sunputc(p);
+ p = removc(p,n);
+ return(p);
+}
+struct blk *
+scale(p,n)
+struct blk *p;
+{
+ register struct blk *q,*s,*t;
+
+ t = add0(p,n);
+ q = salloc(1);
+ sputc(q,n);
+ s = exp(inbas,q);
+ release(q);
+ q = div(t,s);
+ release(t);
+ release(s);
+ release(rem);
+ sputc(q,n);
+ return(q);
+}
+subt(){
+ arg1=pop();
+ EMPTYS;
+ savk = sunputc(arg1);
+ chsign(arg1);
+ sputc(arg1,savk);
+ pushp(arg1);
+ if(eqk() != 0)return(1);
+ binop('+');
+ return(0);
+}
+command(){
+ int c;
+ char line[100],*sl;
+ register (*savint)(),pid,rpid;
+ int retcode;
+
+ switch(c = readc()){
+ case '<':
+ return(cond(NL));
+ case '>':
+ return(cond(NG));
+ case '=':
+ return(cond(NE));
+ default:
+ sl = line;
+ *sl++ = c;
+ while((c = readc()) != '\n')*sl++ = c;
+ *sl = 0;
+ if((pid = fork()) == 0){
+ execl("/bin/sh","sh","-c",line,0);
+ exit(0100);
+ }
+ savint = signal(SIGINT, SIG_IGN);
+ while((rpid = wait(&retcode)) != pid && rpid != -1);
+ signal(SIGINT,savint);
+ printf("!\n");
+ return(0);
+ }
+}
+cond(c)
+char c;
+{
+ register struct blk *p;
+ register char cc;
+
+ if(subt() != 0)return(1);
+ p = pop();
+ sunputc(p);
+ if(length(p) == 0){
+ release(p);
+ if(c == '<' || c == '>' || c == NE){
+ readc();
+ return(0);
+ }
+ load();
+ return(1);
+ }
+ else {
+ if(c == '='){
+ release(p);
+ readc();
+ return(0);
+ }
+ }
+ if(c == NE){
+ release(p);
+ load();
+ return(1);
+ }
+ fsfile(p);
+ cc = sbackc(p);
+ release(p);
+ if((cc<0 && (c == '<' || c == NG)) ||
+ (cc >0) && (c == '>' || c == NL)){
+ readc();
+ return(0);
+ }
+ load();
+ return(1);
+}
+load(){
+ register int c;
+ register struct blk *p,*q;
+ struct blk *t,*s;
+ c = readc() & 0377;
+ sptr = stable[c];
+ if(sptr != 0){
+ p = sptr->val;
+ if(c >= ARRAYST){
+ q = salloc(length(p));
+ rewind(p);
+ while(sfeof(p) == 0){
+ s = getwd(p);
+ if(s == 0){putwd(q, (struct blk *)NULL);}
+ else{
+ t = copy(s,length(s));
+ putwd(q,t);
+ }
+ }
+ pushp(q);
+ }
+ else{
+ q = copy(p,length(p));
+ pushp(q);
+ }
+ }
+ else{
+ q = salloc(1);
+ sputc(q,0);
+ pushp(q);
+ }
+ return;
+}
+log2(n)
+long n;
+{
+ register int i;
+
+ if(n == 0)return(0);
+ i=31;
+ if(n<0)return(i);
+ while((n= n<<1) >0)i--;
+ return(--i);
+}
+
+struct blk *
+salloc(size)
+int size;
+{
+ register struct blk *hdr;
+ register char *ptr;
+ all++;
+ nbytes += size;
+ ptr = malloc((unsigned)size);
+ if(ptr == 0){
+ garbage("salloc");
+ if((ptr = malloc((unsigned)size)) == 0)
+ ospace("salloc");
+ }
+ if((hdr = hfree) == 0)hdr = morehd();
+ hfree = (struct blk *)hdr->rd;
+ hdr->rd = hdr->wt = hdr->beg = ptr;
+ hdr->last = ptr+size;
+ return(hdr);
+}
+struct blk *
+morehd(){
+ register struct blk *h,*kk;
+ headmor++;
+ nbytes += HEADSZ;
+ hfree = h = (struct blk *)malloc(HEADSZ);
+ if(hfree == 0){
+ garbage("morehd");
+ if((hfree = h = (struct blk *)malloc(HEADSZ)) == 0)
+ ospace("headers");
+ }
+ kk = h;
+ while(h<hfree+(HEADSZ/BLK))(h++)->rd = (char *)++kk;
+ (--h)->rd=0;
+ return(hfree);
+}
+/*
+sunputc(hptr)
+struct blk *hptr;
+{
+ hptr->wt--;
+ hptr->rd = hptr->wt;
+ return(*hptr->wt);
+}
+*/
+struct blk *
+copy(hptr,size)
+struct blk *hptr;
+int size;
+{
+ register struct blk *hdr;
+ register unsigned sz;
+ register char *ptr;
+
+ all++;
+ nbytes += size;
+ sz = length(hptr);
+ ptr = nalloc(hptr->beg, (unsigned)size);
+ if(ptr == 0){
+ garbage("copy");
+ if((ptr = nalloc(hptr->beg, (unsigned)size)) == NULL){
+ printf("copy size %d\n",size);
+ ospace("copy");
+ }
+ }
+ if((hdr = hfree) == 0)hdr = morehd();
+ hfree = (struct blk *)hdr->rd;
+ hdr->rd = hdr->beg = ptr;
+ hdr->last = ptr+size;
+ hdr->wt = ptr+sz;
+ ptr = hdr->wt;
+ while(ptr<hdr->last)*ptr++ = '\0';
+ return(hdr);
+}
+sdump(s1,hptr)
+char *s1;
+struct blk *hptr;
+{
+ char *p;
+ printf("%s %o rd %o wt %o beg %o last %o\n",s1,hptr,hptr->rd,hptr->wt,hptr->beg,hptr->last);
+ p = hptr->beg;
+ while(p < hptr->wt)printf("%d ",*p++);
+ printf("\n");
+}
+seekc(hptr,n)
+struct blk *hptr;
+{
+ register char *nn,*p;
+
+ nn = hptr->beg+n;
+ if(nn > hptr->last){
+ nbytes += nn - hptr->last;
+ free(hptr->beg);
+ p = realloc(hptr->beg, (unsigned)n);
+ if(p == 0){
+ hptr->beg = realloc(hptr->beg, (unsigned)(hptr->last-hptr->beg));
+ garbage("seekc");
+ if((p = realloc(hptr->beg, (unsigned)n)) == 0)
+ ospace("seekc");
+ }
+ hptr->beg = p;
+ hptr->wt = hptr->last = hptr->rd = p+n;
+ return;
+ }
+ hptr->rd = nn;
+ if(nn>hptr->wt)hptr->wt = nn;
+ return;
+}
+salterwd(hptr,n)
+struct wblk *hptr;
+struct blk *n;
+{
+ if(hptr->rdw == hptr->lastw)more(hptr);
+ *hptr->rdw++ = n;
+ if(hptr->rdw > hptr->wtw)hptr->wtw = hptr->rdw;
+ return;
+}
+more(hptr)
+struct blk *hptr;
+{
+ register unsigned size;
+ register char *p;
+
+ if((size=(hptr->last-hptr->beg)*2) == 0)size=1;
+ nbytes += size/2;
+ free(hptr->beg);
+ p = realloc(hptr->beg, (unsigned)size);
+ if(p == 0){
+ hptr->beg = realloc(hptr->beg, (unsigned)(hptr->last-hptr->beg));
+ garbage("more");
+ if((p = realloc(hptr->beg,size)) == 0)
+ ospace("more");
+ }
+ hptr->rd = hptr->rd-hptr->beg+p;
+ hptr->wt = hptr->wt-hptr->beg+p;
+ hptr->beg = p;
+ hptr->last = p+size;
+ return;
+}
+ospace(s)
+char *s;
+{
+ printf("out of space: %s\n",s);
+ printf("all %ld rel %ld headmor %ld\n",all,rel,headmor);
+ printf("nbytes %ld\n",nbytes);
+ sdump("stk",*stkptr);
+ abort();
+}
+garbage(s)
+char *s;
+{
+ int i;
+ struct blk *p, *q;
+ struct sym *tmps;
+ int ct;
+
+/* printf("got to garbage %s\n",s); */
+ for(i=0;i<TBLSZ;i++){
+ tmps = stable[i];
+ if(tmps != 0){
+ if(i < ARRAYST){
+ do {
+ p = tmps->val;
+ if(((int)p->beg & 01) != 0){
+ printf("string %o\n",i);
+ sdump("odd beg",p);
+ }
+ redef(p);
+ tmps = tmps->next;
+ } while(tmps != 0);
+ continue;
+ }
+ else {
+ do {
+ p = tmps->val;
+ rewind(p);
+ ct = 0;
+ while((q = getwd(p)) != NULL){
+ ct++;
+ if(q != 0){
+ if(((int)q->beg & 01) != 0){
+ printf("array %o elt %d odd\n",i-ARRAYST,ct);
+printf("tmps %o p %o\n",tmps,p);
+ sdump("elt",q);
+ }
+ redef(q);
+ }
+ }
+ tmps = tmps->next;
+ } while(tmps != 0);
+ }
+ }
+ }
+}
+redef(p)
+struct blk *p;
+{
+ register offset;
+ register char *newp;
+
+ if ((int)p->beg&01) {
+ printf("odd ptr %o hdr %o\n",p->beg,p);
+ ospace("redef-bad");
+ }
+ free(p->beg);
+ free(dummy);
+ dummy = malloc(1);
+ if(dummy == NULL)ospace("dummy");
+ newp = realloc(p->beg, (unsigned)(p->last-p->beg));
+ if(newp == NULL)ospace("redef");
+ offset = newp - p->beg;
+ p->beg = newp;
+ p->rd += offset;
+ p->wt += offset;
+ p->last += offset;
+}
+
+release(p)
+register struct blk *p;
+{
+ rel++;
+ nbytes -= p->last - p->beg;
+ p->rd = (char *)hfree;
+ hfree = p;
+ free(p->beg);
+}
+
+struct blk *
+getwd(p)
+struct blk *p;
+{
+ register struct wblk *wp;
+
+ wp = (struct wblk *)p;
+ if (wp->rdw == wp->wtw)
+ return(NULL);
+ return(*wp->rdw++);
+}
+
+putwd(p, c)
+struct blk *p, *c;
+{
+ register struct wblk *wp;
+
+ wp = (struct wblk *)p;
+ if (wp->wtw == wp->lastw)
+ more(p);
+ *wp->wtw++ = c;
+}
+
+struct blk *
+lookwd(p)
+struct blk *p;
+{
+ register struct wblk *wp;
+
+ wp = (struct wblk *)p;
+ if (wp->rdw == wp->wtw)
+ return(NULL);
+ return(*wp->rdw);
+}
+char *
+nalloc(p,nbytes)
+register char *p;
+unsigned nbytes;
+{
+ char *malloc();
+ register char *q, *r;
+ q = r = malloc(nbytes);
+ if(q==0)
+ return(0);
+ while(nbytes--)
+ *q++ = *p++;
+ return(r);
+}
projects / unix-history / commitdiff