diff options
Diffstat (limited to 'sys/cmd/calc/calc.c')
-rw-r--r-- | sys/cmd/calc/calc.c | 2285 |
1 files changed, 0 insertions, 2285 deletions
diff --git a/sys/cmd/calc/calc.c b/sys/cmd/calc/calc.c deleted file mode 100644 index dd99e37..0000000 --- a/sys/cmd/calc/calc.c +++ /dev/null @@ -1,2285 +0,0 @@ -#include <u.h> -#include <libn.h> - -typedef void* pointer; - -#define div dcdiv - -#define FATAL 0 -#define NFATAL 1 -#define BLK sizeof(Blk) -#define PTRSZ sizeof(int*) -#define HEADSZ 1024 -#define STKSZ 100 -#define RDSKSZ 100 -#define TBLSZ 256 -#define ARRAYST 221 -#define MAXIND 2048 -#define NL 1 -#define NG 2 -#define NE 3 -#define length(p) ((p)->wt-(p)->beg) -#define rewind(p) (p)->rd=(p)->beg -#undef create -#define create(p) (p)->rd = (p)->wt = (p)->beg -#define fsfile(p) (p)->rd = (p)->wt -#define truncate(p) (p)->wt = (p)->rd -#define sfeof(p) (((p)->rd==(p)->wt)?1:0) -#define sfbeg(p) (((p)->rd==(p)->beg)?1:0) -#define sungetc(p,c) *(--(p)->rd)=c -#define sgetc(p) (((p)->rd==(p)->wt)?-1:*(p)->rd++) -#define skipc(p) {if((p)->rd<(p)->wt)(p)->rd++;} -#define slookc(p) (((p)->rd==(p)->wt)?-1:*(p)->rd) -#define sbackc(p) (((p)->rd==(p)->beg)?-1:*(--(p)->rd)) -#define backc(p) {if((p)->rd>(p)->beg) --(p)->rd;} -#define sputc(p,c) {if((p)->wt==(p)->last)more(p);\ - *(p)->wt++ = c; } -#define salterc(p,c) {if((p)->rd==(p)->last)more(p);\ - *(p)->rd++ = c;\ - if((p)->rd>(p)->wt)(p)->wt=(p)->rd;} -#define sunputc(p) (*((p)->rd = --(p)->wt)) -#define sclobber(p) ((p)->rd = --(p)->wt) -#define zero(p) for(pp=(p)->beg;pp<(p)->last;)\ - *pp++='\0' -#define OUTC(x) {Bputc(&bout,x); if(--count == 0){Bprint(&bout,"\\\n"); count=ll;} } -#define TEST2 {if((count -= 2) <=0){Bprint(&bout,"\\\n");count=ll;}} -#define EMPTY if(stkerr != 0){Bprint(&bout,"stack empty\n"); continue; } -#define EMPTYR(x) if(stkerr!=0){pushp(x);Bprint(&bout,"stack empty\n");continue;} -#define EMPTYS if(stkerr != 0){Bprint(&bout,"stack empty\n"); return(1);} -#define EMPTYSR(x) if(stkerr !=0){Bprint(&bout,"stack empty\n");pushp(x);return(1);} -#define error(p) {Bprint(&bout,p); continue; } -#define errorrt(p) {Bprint(&bout,p); return(1); } -#define LASTFUN 026 - -typedef struct Blk Blk; -struct Blk -{ - char *rd; - char *wt; - char *beg; - char *last; -}; -typedef struct Sym Sym; -struct Sym -{ - Sym *next; - Blk *val; -}; -typedef struct Wblk Wblk; -struct Wblk -{ - Blk **rdw; - Blk **wtw; - Blk **begw; - Blk **lastw; -}; - -Blk *arg1, *arg2; -uchar savk; -int dbg; -int ifile; -Blk *scalptr, *basptr, *tenptr, *inbas; -Blk *sqtemp, *chptr, *strptr, *divxyz; -Blk *stack[STKSZ]; -Blk **stkptr,**stkbeg; -Blk **stkend; -Blk *hfree; -int stkerr; -int lastchar; -Blk *readstk[RDSKSZ]; -Blk **readptr; -Blk *rem; -int k; -Blk *irem; -int skd,skr; -int neg; -Sym symlst[TBLSZ]; -Sym *stable[TBLSZ]; -Sym *sptr, *sfree; -long rel; -long nbytes; -long all; -long headmor; -long obase; -int fw,fw1,ll; -void (*outdit)(Blk *p, int flg); -int logo; -int logten; -int count; -char *pp; -char *dummy; -long longest, maxsize, active; -int lall, lrel, lcopy, lmore, lbytes; -int inside; -Biobuf bin; -Biobuf bout; - -void main(int argc, char *argv[]); -void commnds(void); -Blk* readin(void); -Blk* div(Blk *ddivd, Blk *ddivr); -int dscale(void); -Blk* removr(Blk *p, int n); -Blk* dcsqrt(Blk *p); -void init(int argc, char *argv[]); -void onintr(void); -void pushp(Blk *p); -Blk* pop(void); -Blk* readin(void); -Blk* add0(Blk *p, int ct); -Blk* mult(Blk *p, Blk *q); -void chsign(Blk *p); -int readc(void); -void unreadc(char c); -void binop(char c); -void dcprint(Blk *hptr); -Blk* dcexp(Blk *base, Blk *ex); -Blk* getdec(Blk *p, int sc); -void tenot(Blk *p, int sc); -void oneot(Blk *p, int sc, char ch); -void hexot(Blk *p, int flg); -void bigot(Blk *p, int flg); -Blk* add(Blk *a1, Blk *a2); -int eqk(void); -Blk* removc(Blk *p, int n); -Blk* scalint(Blk *p); -Blk* scale(Blk *p, int n); -int subt(void); -int command(void); -int cond(char c); -void load(void); -#define log2 dclog2 -int log2(long n); -Blk* salloc(int size); -Blk* morehd(void); -Blk* copy(Blk *hptr, int size); -void sdump(char *s1, Blk *hptr); -void seekc(Blk *hptr, int n); -void salterwd(Blk *hptr, Blk *n); -void more(Blk *hptr); -void ospace(char *s); -void garbage(char *s); -void release(Blk *p); -Blk* dcgetwd(Blk *p); -void putwd(Blk *p, Blk *c); -Blk* lookwd(Blk *p); -int getstk(void); - -/********debug only**/ -void -tpr(char *cp, Blk *bp) -{ - print("%s-> ", cp); - print("beg: %lx rd: %lx wt: %lx last: %lx\n", bp->beg, bp->rd, - bp->wt, bp->last); - for (cp = bp->beg; cp != bp->wt; cp++) { - print("%d", *cp); - if (cp != bp->wt-1) - print("/"); - } - print("\n"); -} -/************/ - -void -main(int argc, char *argv[]) -{ - Binit(&bin, 0, OREAD); - Binit(&bout, 1, OWRITE); - init(argc,argv); - commnds(); - exits(0); -} - -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 '\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); - } - } -} - -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); -} - -int -dscale(void) -{ - Blk *dd, *dr, *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); - Bprint(&bout,"divide by 0\n"); - return(1); - } - if(sfbeg(dd) == 1 || (sfbeg(dd) == 0 && sbackc(dd) == 0)) { - sputc(dd,skd); - pushp(dd); - return(1); - } - 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); -} - -Blk* -removr(Blk *p, int n) -{ - int nn, neg; - Blk *q, *s, *r; - - fsfile(p); - neg = sbackc(p); - if(neg < 0) - chsign(p); - 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); - if(neg < 0){ - chsign(s); - chsign(q); - irem = q; - return(s); - } - irem = q; - return(s); - } - if(neg < 0) { - chsign(r); - chsign(q); - irem = q; - return(r); - } - irem = q; - return(r); -} - -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* -dcexp(Blk *base, Blk *ex) -{ - Blk *r, *e, *p, *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); -} - -void -init(int argc, char *argv[]) -{ - Sym *sp; - Dir *d; - - ARGBEGIN { - default: - dbg = 1; - break; - } ARGEND - ifile = 1; - curfile = &bin; - if(*argv){ - d = dirstat(*argv); - if(d == nil) { - fprint(2, "dc: can't open file %s\n", *argv); - exits("open"); - } - if(d->mode & DMDIR) { - fprint(2, "dc: file %s is a directory\n", *argv); - exits("open"); - } - free(d); - if((curfile = Bopen(*argv, OREAD)) == 0) { - fprint(2,"dc: can't open file %s\n", *argv); - exits("open"); - } - } -/* dummy = malloc(0); *//* prepare for garbage-collection */ - scalptr = salloc(1); - sputc(scalptr,0); - basptr = salloc(1); - sputc(basptr,10); - obase=10; - logten=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-1]) { - sptr->next = ++sp; - sptr++; - } - sptr->next=0; - sfree = &symlst[0]; -} - -void -pushp(Blk *p) -{ - if(stkptr == stkend) { - Bprint(&bout,"out of stack space\n"); - return; - } - stkerr=0; - *++stkptr = p; - return; -} - -Blk* -pop(void) -{ - if(stkptr == stack) { - stkerr=1; - return(0); - } - return(*stkptr--); -} - -Blk* -readin(void) -{ - Blk *p, *q; - int dp, dpct, c; - - dp = dpct=0; - p = salloc(0); - for(;;){ - c = readc(); - switch(c) { - case '.': - if(dp != 0) - goto gotnum; - 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); - } -} - -/* - * returns pointer to struct with ct 0's & p - */ -Blk* -add0(Blk *p, int ct) -{ - 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); -} - -Blk* -mult(Blk *p, Blk *q) -{ - 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); -} - -void -chsign(Blk *p) -{ - int carry; - 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); - backc(p); - ct = sbackc(p); - if(ct == 99 /*&& !sfbeg(p)*/) { - truncate(p); - sputc(p,-1); - } - } else{ - fsfile(p); - ct = sbackc(p); - if(ct == 0) - truncate(p); - } - return; -} - -int -readc(void) -{ -loop: - if((readptr != &readstk[0]) && (*readptr != 0)) { - if(sfeof(*readptr) == 0) - return(lastchar = sgetc(*readptr)); - release(*readptr); - readptr--; - goto loop; - } - lastchar = Bgetc(curfile); - if(lastchar != -1) - return(lastchar); - if(readptr != &readptr[0]) { - readptr--; - if(*readptr == 0) - curfile = &bin; - goto loop; - } - if(curfile != &bin) { - Bterm(curfile); - curfile = &bin; - goto loop; - } - exits(0); - return 0; /* shut up ken */ -} - -void -unreadc(char c) -{ - - if((readptr != &readstk[0]) && (*readptr != 0)) { - sungetc(*readptr,c); - } else - Bungetc(curfile); - return; -} - -void -binop(char c) -{ - Blk *r; - - r = 0; - 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); -} - -void -dcprint(Blk *hptr) -{ - Blk *p, *q, *dec; - int dig, dout, ct, sc; - - rewind(hptr); - while(sfeof(hptr) == 0) { - if(sgetc(hptr)>99) { - rewind(hptr); - while(sfeof(hptr) == 0) { - Bprint(&bout,"%c",sgetc(hptr)); - } - Bprint(&bout,"\n"); - return; - } - } - fsfile(hptr); - sc = sbackc(hptr); - if(sfbeg(hptr) != 0) { - Bprint(&bout,"0\n"); - return; - } - count = ll; - p = copy(hptr,length(hptr)); - sclobber(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; - } - /* sleazy hack to scale top of stack - divide by 1 */ - pushp(p); - sputc(p, sc); - p=salloc(0); - create(p); - sputc(p, 1); - sputc(p, 0); - pushp(p); - if(dscale() != 0) - return; - p = div(arg1, arg2); - release(arg1); - release(arg2); - sc = savk; - - create(strptr); - dig = logten*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); - Bprint(&bout,"\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)); - Bprint(&bout,"\n"); -} - -Blk* -getdec(Blk *p, int sc) -{ - int cc; - 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); -} - -void -tenot(Blk *p, int sc) -{ - 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)) - Bprint(&bout,"0%d",c); - else - Bprint(&bout,"%d",c); - f=1; - TEST2; - } - if(sc == 0) { - Bprint(&bout,"\n"); - release(p); - return; - } - if((p->rd-p->beg)*2 > sc) { - c = sbackc(p); - Bprint(&bout,"%d.",c/10); - TEST2; - OUTC(c%10 +'0'); - sc--; - } else { - OUTC('.'); - } - while(sc>(p->rd-p->beg)*2) { - OUTC('0'); - sc--; - } - while(sc > 1) { - c = sbackc(p); - if(c<10) - Bprint(&bout,"0%d",c); - else - Bprint(&bout,"%d",c); - sc -= 2; - TEST2; - } - if(sc == 1) { - OUTC(sbackc(p)/10 +'0'); - } - Bprint(&bout,"\n"); - release(p); -} - -void -oneot(Blk *p, int sc, char ch) -{ - 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); - Bprint(&bout,"\n"); -} - -void -hexot(Blk *p, int flg) -{ - int c; - - USED(flg); - rewind(p); - if(sfeof(p) != 0) { - sputc(strptr,'0'); - release(p); - return; - } - c = sgetc(p); - release(p); - if(c >= 16) { - Bprint(&bout,"hex digit > 16"); - return; - } - sputc(strptr,c<10?c+'0':c-10+'a'); -} - -void -bigot(Blk *p, int flg) -{ - Blk *t, *q; - int neg, l; - - if(flg == 1) { - t = salloc(0); - l = 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) { - sclobber(strptr); - sputc(strptr,'-'); - } - } - sputc(strptr,' '); -} - -Blk* -add(Blk *a1, Blk *a2) -{ - Blk *p; - int carry, n, size, 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) { - c = 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 == -1) - break; - } - skipc(p); - salterc(p,-1); - truncate(p); - } - return(p); -} - -int -eqk(void) -{ - Blk *p, *q; - int skp, 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); - } - if(skp < skq) { - savk = skq; - p = add0(p,skq-skp); - } else { - savk = skp; - q = add0(q,skp-skq); - } - arg1=p; - arg2=q; - return(0); -} - -Blk* -removc(Blk *p, int n) -{ - Blk *q, *r; - - rewind(p); - while(n>1) { - skipc(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); -} - -Blk* -scalint(Blk *p) -{ - int n; - - n = sunputc(p); - p = removc(p,n); - return(p); -} - -Blk* -scale(Blk *p, int n) -{ - Blk *q, *s, *t; - - t = add0(p,n); - q = salloc(1); - sputc(q,n); - s = dcexp(inbas,q); - release(q); - q = div(t,s); - release(t); - release(s); - release(rem); - sputc(q,n); - return(q); -} - -int -subt(void) -{ - arg1=pop(); - EMPTYS; - savk = sunputc(arg1); - chsign(arg1); - sputc(arg1,savk); - pushp(arg1); - if(eqk() != 0) - return(1); - binop('+'); - return(0); -} - -int -command(void) -{ - char line[100], *sl; - int pid, p, c; - - 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/rc","rc","-c",line,0); - exits("shell"); - } - for(;;) { - if((p = waitpid()) < 0) - break; - if(p== pid) - break; - } - Bprint(&bout,"!\n"); - return(0); - } -} - -int -cond(char c) -{ - Blk *p; - int cc; - - if(subt() != 0) - return(1); - p = pop(); - sclobber(p); - if(length(p) == 0) { - release(p); - if(c == '<' || c == '>' || c == NE) { - getstk(); - return(0); - } - load(); - return(1); - } - if(c == '='){ - release(p); - getstk(); - 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)) { - getstk(); - return(0); - } - load(); - return(1); -} - -void -load(void) -{ - int c; - Blk *p, *q, *t, *s; - - c = getstk() & 0377; - sptr = stable[c]; - if(sptr != 0) { - p = sptr->val; - if(c >= ARRAYST) { - q = salloc(length(p)); - rewind(p); - while(sfeof(p) == 0) { - s = dcgetwd(p); - if(s == 0) { - putwd(q, (Blk*)0); - } else { - t = copy(s,length(s)); - putwd(q,t); - } - } - pushp(q); - } else { - q = copy(p,length(p)); - pushp(q); - } - } else { - q = salloc(1); - if(c <= LASTFUN) { - Bprint(&bout,"function %c undefined\n",c+'a'-1); - sputc(q,'c'); - sputc(q,'0'); - sputc(q,' '); - sputc(q,'1'); - sputc(q,'Q'); - } - else - sputc(q,0); - pushp(q); - } -} - -int -log2(long n) -{ - int i; - - if(n == 0) - return(0); - i=31; - if(n<0) - return(i); - while((n= n<<1) >0) - i--; - return i-1; -} - -Blk* -salloc(int size) -{ - Blk *hdr; - char *ptr; - - all++; - lall++; - if(all - rel > active) - active = all - rel; - nbytes += size; - lbytes += size; - if(nbytes >maxsize) - maxsize = nbytes; - if(size > longest) - longest = 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 = (Blk *)hdr->rd; - hdr->rd = hdr->wt = hdr->beg = ptr; - hdr->last = ptr+size; - return(hdr); -} - -Blk* -morehd(void) -{ - Blk *h, *kk; - - headmor++; - nbytes += HEADSZ; - hfree = h = (Blk *)malloc(HEADSZ); - if(hfree == 0) { - garbage("morehd"); - if((hfree = h = (Blk*)malloc(HEADSZ)) == 0) - ospace("headers"); - } - kk = h; - while(h<hfree+(HEADSZ/BLK)) - (h++)->rd = (char*)++kk; - (h-1)->rd=0; - return(hfree); -} - -Blk* -copy(Blk *hptr, int size) -{ - Blk *hdr; - unsigned sz; - char *ptr; - - all++; - lall++; - lcopy++; - nbytes += size; - lbytes += size; - if(size > longest) - longest = size; - if(size > maxsize) - maxsize = size; - sz = length(hptr); - ptr = malloc(size); - if(ptr == 0) { - Bprint(&bout,"copy size %d\n",size); - ospace("copy"); - } - memmove(ptr, hptr->beg, sz); - memset(ptr+sz, 0, size-sz); - if((hdr = hfree) == 0) - hdr = morehd(); - hfree = (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); -} - -void -sdump(char *s1, Blk *hptr) -{ - char *p; - - Bprint(&bout,"%s %lx rd %lx wt %lx beg %lx last %lx\n", - s1,hptr,hptr->rd,hptr->wt,hptr->beg,hptr->last); - p = hptr->beg; - while(p < hptr->wt) - Bprint(&bout,"%d ",*p++); - Bprint(&bout,"\n"); -} - -void -seekc(Blk *hptr, int n) -{ - char *nn,*p; - - nn = hptr->beg+n; - if(nn > hptr->last) { - nbytes += nn - hptr->last; - if(nbytes > maxsize) - maxsize = nbytes; - lbytes += nn - hptr->last; - if(n > longest) - longest = n; -/* free(hptr->beg); */ - p = realloc(hptr->beg, n); - if(p == 0) { -/* hptr->beg = realloc(hptr->beg, hptr->last-hptr->beg); -** garbage("seekc"); -** if((p = realloc(hptr->beg, 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; -} - -void -salterwd(Blk *ahptr, Blk *n) -{ - Wblk *hptr; - - hptr = (Wblk*)ahptr; - if(hptr->rdw == hptr->lastw) - more(ahptr); - *hptr->rdw++ = n; - if(hptr->rdw > hptr->wtw) - hptr->wtw = hptr->rdw; -} - -void -more(Blk *hptr) -{ - unsigned size; - char *p; - - if((size=(hptr->last-hptr->beg)*2) == 0) - size=2; - nbytes += size/2; - if(nbytes > maxsize) - maxsize = nbytes; - if(size > longest) - longest = size; - lbytes += size/2; - lmore++; -/* free(hptr->beg);*/ - p = realloc(hptr->beg, size); - - if(p == 0) { -/* hptr->beg = realloc(hptr->beg, (hptr->last-hptr->beg)); -** garbage("more"); -** if((p = realloc(hptr->beg,size)) == 0) -*/ ospace("more"); - } - hptr->rd = p + (hptr->rd - hptr->beg); - hptr->wt = p + (hptr->wt - hptr->beg); - hptr->beg = p; - hptr->last = p+size; -} - -void -ospace(char *s) -{ - Bprint(&bout,"out of space: %s\n",s); - Bprint(&bout,"all %ld rel %ld headmor %ld\n",all,rel,headmor); - Bprint(&bout,"nbytes %ld\n",nbytes); - sdump("stk",*stkptr); - abort(); -} - -void -garbage(char *s) -{ - USED(s); -} - -void -release(Blk *p) -{ - rel++; - lrel++; - nbytes -= p->last - p->beg; - p->rd = (char*)hfree; - hfree = p; - free(p->beg); -} - -Blk* -dcgetwd(Blk *p) -{ - Wblk *wp; - - wp = (Wblk*)p; - if(wp->rdw == wp->wtw) - return(0); - return(*wp->rdw++); -} - -void -putwd(Blk *p, Blk *c) -{ - Wblk *wp; - - wp = (Wblk*)p; - if(wp->wtw == wp->lastw) - more(p); - *wp->wtw++ = c; -} - -Blk* -lookwd(Blk *p) -{ - Wblk *wp; - - wp = (Wblk*)p; - if(wp->rdw == wp->wtw) - return(0); - return(*wp->rdw); -} - -int -getstk(void) -{ - int n; - uchar c; - - c = readc(); - if(c != '<') - return c; - n = 0; - while(1) { - c = readc(); - if(c == '>') - break; - n = n*10+c-'0'; - } - return n; -} |