Blk* dcsqrt(Blk *p) { Blk *t, *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); backc(r); if(c>=100) { c -= 100; salterc(r,c); sputc(r,1); } else salterc(r,c); for(;;){ 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); }
Blk* div(Blk *ddivd, Blk *ddivr) { int divsign, remsign, offset, divcarry, carry, dig, magic, d, dd, under, first; long c, td, cc; Blk *ps, *px, *p, *divd, *divr; dig = 0; under = 0; divcarry = 0; rem = 0; p = salloc(0); if(length(ddivr) == 0) { pushp(ddivr); Bprint(&bout,"divide by 0\n"); return(p); } divsign = remsign = first = 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) { first++; 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++; else cc++; if(magic != 0) td = td<<3; dig = td/cc; under=0; if(td%cc < 8 && dig > 0 && magic) { dig--; under=1; } 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; backc(p); salterc(p,dig); backc(p); fsfile(divd); d=sbackc(divd); if((d != 0) && /*!divcarry*/ (offset != 0)) { d = sbackc(divd) + 100; salterc(divd,d); } if(--offset >= 0) divd->wt--; } if(under) { /* undershot last - adjust*/ px = copy(divr,length(divr)); /*11/88 don't corrupt ddivr*/ chsign(px); ps = add(px,divd); fsfile(ps); if(length(ps) > 0 && sbackc(ps) < 0) { release(ps); /*only adjust in really undershot*/ } else { release(divd); salterc(p, dig+1); divd=ps; } } 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) break; truncate(p); } if(divsign < 0) chsign(p); fsfile(divd); while(sfbeg(divd) == 0) { if(sbackc(divd) != 0) break; truncate(divd); } ddone: if(remsign<0) chsign(divd); if(divr != ddivr) release(divr); rem = divd; return(p); }
void commnds(void) { Blk *p, *q, **ptr, *s, *t; long l; Sym *sp; int sk, sk1, sk2, c, sign, n, d; while(1) { Bflush(&bout); if(((c = readc())>='0' && c <= '9') || (c>='A' && c <='F') || c == '.') { unreadc(c); p = readin(); pushp(p); continue; } switch(c) { case ' ': case '\t': case '\n': case -1: continue; case 'Y': sdump("stk",*stkptr); Bprint(&bout, "all %ld rel %ld headmor %ld\n",all,rel,headmor); Bprint(&bout, "nbytes %ld\n",nbytes); Bprint(&bout, "longest %ld active %ld maxsize %ld\n", longest, active, maxsize); Bprint(&bout, "new all %d rel %d copy %d more %d lbytes %d\n", lall, lrel, lcopy, lmore, lbytes); lall = lrel = lcopy = lmore = lbytes = 0; 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); savk = sk1+sk2; binop('*'); p = pop(); if(savk>k && savk>sk1 && savk>sk2) { sclobber(p); 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(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 = dcsqrt(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 = dcexp(arg2,arg1); release(arg2); rewind(arg1); c = sgetc(arg1); if(c == -1) c = 0; else if(sfeof(arg1) == 0) c = sgetc(arg1)*100 + c; d = c*savk; release(arg1); /* if(neg == 0) { removed to fix -exp bug*/ 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 { this is disaster for exp <-127 */ /* 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); backc(p); if(sfbeg(p) == 0) { if((c = sbackc(p))<0) { n -= 2; if(sfbeg(p) == 1) n++; else { if((c = sbackc(p)) == 0) n++; else if(c > 90) n--; } } else if(c < 10) n--; } 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(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); for(;;) { 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 = 0; if(!sfeof(p)) k = 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]) exits(0); if(*readptr != 0) release(*readptr); readptr--; if(*readptr != 0) release(*readptr); readptr--; continue; case 'f': if(stkptr == &stack[0]) Bprint(&bout,"empty stack\n"); else { for(ptr = stkptr; ptr > &stack[0];) { dcprint(*ptr--); } } continue; case 'p': if(stkptr == &stack[0]) Bprint(&bout,"empty stack\n"); else { dcprint(*stkptr); } continue; case 'P': p = pop(); EMPTY; sputc(p,0); Bprint(&bout,"%s",p->beg); release(p); continue; case 'd': if(stkptr == &stack[0]) { Bprint(&bout,"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 = getstk() & 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,length(p)+PTRSZ); for(n = 0;n < PTRSZ;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 = getstk() & 0377; sptr = stable[c]; if(sptr != 0) { p = sptr->val; if(c >= ARRAYST) { rewind(p); while(sfeof(p) == 0) release(dcgetwd(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 = getstk() & 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 = dcgetwd(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 = getstk() & 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!=0) 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 = getstk() & 0377; sptr = stable[n]; if(sptr != 0){ p = sptr->val; if(length(p)-PTRSZ >= c*PTRSZ) { seekc(p,c*PTRSZ); s = dcgetwd(p); if(s != 0) { q = copy(s,length(s)); pushp(q); continue; } } } q = salloc(1); /*so uninitialized array elt prints as 0*/ sputc(q, 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 = &bin; 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: Bprint(&bout,"%o is unimplemented\n",c); } } }
void commnds(void){ 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 = n = sk1+sk2; if(n>k && n>sk1 && n>sk2){ sk = sk1; if(sk<sk2)sk = sk2; if(sk<k)sk = k; p = removc(p,n-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 = dcsqrt(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 = dcexp(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); } } if (l > BC_BASE_MAX) error("output base is too large\n"); logo = log_2(l); obase = l; release(basptr); if(sign == 1)obase = (long)-l; basptr = p; outdit = (int (*)(struct blk *, int, int))bigot; if(n == 1 && sign == 0){ if(c <= 16){ outdit = (int (*)(struct blk *, int, int))hexot; fw = 1; fw1 = 0; ll = 68; 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 = 68; if(fw>=ll)continue; ll = (68/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,length(p)); for(n = 0;n < PTRSZ;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(dcgetwd(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 = dcgetwd(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 >= BC_DIM_MAX){ 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((struct wblk *)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 >= BC_DIM_MAX){ 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 = dcgetwd(p); if(s != 0){ q = copy(s,length(s)); pushp(q); continue; } } } q = salloc(1); sputc(q, 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(struct blk *ddivd,struct blk *ddivr) { int divsign,remsign,offset,divcarry = 0; int carry, dig = 0,magic,d = 0,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); printf("divide by 0\n"); return NULL; } 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){ if(d > 0){ sbackc(divd); dd=sbackc(divd); salterc(divd,dd+100); } 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); }