6 #pragma varargck type "lx" pointer
10 #define BLK sizeof(Blk)
11 #define PTRSZ sizeof(int*)
12 #define TBLSZ 256 /* 1<<BI2BY */
24 #define length(p) ((p)->wt-(p)->beg)
25 #define rewind(p) (p)->rd=(p)->beg
26 #define create(p) (p)->rd = (p)->wt = (p)->beg
27 #define fsfile(p) (p)->rd = (p)->wt
28 #define truncate(p) (p)->wt = (p)->rd
29 #define sfeof(p) (((p)->rd==(p)->wt)?1:0)
30 #define sfbeg(p) (((p)->rd==(p)->beg)?1:0)
31 #define sungetc(p,c) *(--(p)->rd)=c
32 #define sgetc(p) (((p)->rd==(p)->wt)?-1:*(p)->rd++)
33 #define skipc(p) {if((p)->rd<(p)->wt)(p)->rd++;}
34 #define slookc(p) (((p)->rd==(p)->wt)?-1:*(p)->rd)
35 #define sbackc(p) (((p)->rd==(p)->beg)?-1:*(--(p)->rd))
36 #define backc(p) {if((p)->rd>(p)->beg) --(p)->rd;}
37 #define sputc(p,c) {if((p)->wt==(p)->last)more(p);\
39 #define salterc(p,c) {if((p)->rd==(p)->last)more(p);\
41 if((p)->rd>(p)->wt)(p)->wt=(p)->rd;}
42 #define sunputc(p) (*((p)->rd = --(p)->wt))
43 #define sclobber(p) ((p)->rd = --(p)->wt)
44 #define zero(p) for(pp=(p)->beg;pp<(p)->last;)\
46 #define OUTC(x) {Bputc(&bout,x); if(--count == 0){Bprint(&bout,"\\\n"); count=ll;} }
47 #define TEST2 {if((count -= 2) <=0){Bprint(&bout,"\\\n");count=ll;}}
48 #define EMPTY if(stkerr != 0){Bprint(&bout,"stack empty\n"); continue; }
49 #define EMPTYR(x) if(stkerr!=0){pushp(x);Bprint(&bout,"stack empty\n");continue;}
50 #define EMPTYS if(stkerr != 0){Bprint(&bout,"stack empty\n"); return(1);}
51 #define EMPTYSR(x) if(stkerr !=0){Bprint(&bout,"stack empty\n");pushp(x);return(1);}
52 #define error(p) {Bprint(&bout,p); continue; }
53 #define errorrt(p) {Bprint(&bout,p); return(1); }
57 typedef struct Blk Blk;
65 typedef struct Sym Sym;
71 typedef struct Wblk Wblk;
80 Biobuf *curfile, *fsave;
85 Blk *scalptr, *basptr, *tenptr, *inbas;
86 Blk *sqtemp, *chptr, *strptr, *divxyz;
88 Blk **stkptr,**stkbeg;
109 void (*outdit)(Blk *p, int flg);
115 long longest, maxsize, active;
116 int lall, lrel, lcopy, lmore, lbytes;
121 void main(int argc, char *argv[]);
124 Blk* div(Blk *ddivd, Blk *ddivr);
126 Blk* removr(Blk *p, int n);
128 void init(int argc, char *argv[]);
133 Blk* add0(Blk *p, int ct);
134 Blk* mult(Blk *p, Blk *q);
137 void unreadc(char c);
139 void dcprint(Blk *hptr);
140 Blk* dcexp(Blk *base, Blk *ex);
141 Blk* getdec(Blk *p, int sc);
142 void tenot(Blk *p, int sc);
143 void oneot(Blk *p, int sc, char ch);
144 void hexot(Blk *p, int flg);
145 void bigot(Blk *p, int flg);
146 Blk* add(Blk *a1, Blk *a2);
148 Blk* removc(Blk *p, int n);
149 Blk* scalint(Blk *p);
150 Blk* scale(Blk *p, int n);
156 Blk* salloc(int size);
158 Blk* copy(Blk *hptr, int size);
159 void sdump(char *s1, Blk *hptr);
160 void seekc(Blk *hptr, int n);
161 void salterwd(Blk *hptr, Blk *n);
162 void more(Blk *hptr);
163 void ospace(char *s);
164 void garbage(char *s);
165 void release(Blk *p);
166 Blk* dcgetwd(Blk *p);
167 void putwd(Blk *p, Blk *c);
171 /********debug only**/
173 tpr(char *cp, Blk *bp)
176 print("beg: %lx rd: %lx wt: %lx last: %lx\n", bp->beg, bp->rd,
178 for (cp = bp->beg; cp != bp->wt; cp++) {
188 main(int argc, char *argv[])
190 Binit(&bin, 0, OREAD);
191 Binit(&bout, 1, OWRITE);
200 Blk *p, *q, **ptr, *s, *t;
203 int sk, sk1, sk2, c, sign, n, d;
207 if(((c = readc())>='0' && c <= '9') ||
208 (c>='A' && c <='F') || c == '.') {
221 sdump("stk",*stkptr);
222 Bprint(&bout, "all %ld rel %ld headmor %ld\n",all,rel,headmor);
223 Bprint(&bout, "nbytes %ld\n",nbytes);
224 Bprint(&bout, "longest %ld active %ld maxsize %ld\n", longest,
226 Bprint(&bout, "new all %d rel %d copy %d more %d lbytes %d\n",
227 lall, lrel, lcopy, lmore, lbytes);
228 lall = lrel = lcopy = lmore = lbytes = 0;
255 if(savk>k && savk>sk1 && savk>sk2) {
262 p = removc(p,savk-sk);
288 p = add0(rem,skd-(skr+k));
305 error("sqrt of neg number\n");
323 if(sunputc(arg1) != 0)
324 error("exp not an integer\n");
327 if(sfbeg(arg1) == 0 && sbackc(arg1)<0) {
331 if(length(arg1)>=3) {
332 error("exp too big\n");
334 savk = sunputc(arg2);
335 p = dcexp(arg2,arg1);
343 c = sgetc(arg1)*100 + c;
346 /* if(neg == 0) { removed to fix -exp bug*/
359 /* } else { this is disaster for exp <-127 */
386 n = (length(p)-1)<<1;
390 if((c = sbackc(p))<0) {
395 if((c = sbackc(p)) == 0)
423 p = copy(inbas,length(inbas)+1);
456 if(n == 1 && sign == 0) {
487 p = copy(basptr,length(basptr)+1);
495 if((c = readc()) == ']') {
511 error("scale too big\n");
521 p = copy(scalptr,length(scalptr)+1);
543 if((c = sgetc(p))<0) {
548 if(readptr == &readstk[0]) {
557 if(readptr <= &readstk[1])
567 if(stkptr == &stack[0])
568 Bprint(&bout,"empty stack\n");
570 for(ptr = stkptr; ptr > &stack[0];) {
576 if(stkptr == &stack[0])
577 Bprint(&bout,"empty stack\n");
586 Bprint(&bout,"%s",p->beg);
590 if(stkptr == &stack[0]) {
591 Bprint(&bout,"empty stack\n");
607 if(stkptr == &stack[0]) {
608 error("save: args\n");
612 sp = stable[c] = sfree;
620 q = copy(p,length(p)+PTRSZ);
621 for(n = 0;n < PTRSZ;n++) {
630 error("symbol table overflow\n");
632 if(stkptr == &stack[0]) {
633 error("save:args\n");
646 sptr = stable[c] = sfree;
664 stable[c] = sptr->next;
670 while(sfeof(p) == 0) {
684 if((sfbeg(q) == 0) && ((c = sbackc(q))<0)) {
685 error("neg index\n");
688 error("index too big\n");
693 error("index too big\n");
699 sptr = stable[n] = sfree;
704 p = salloc((c+PTRSZ)*PTRSZ);
708 if(length(p)-PTRSZ < c*PTRSZ) {
709 q = copy(p,(c+PTRSZ)*PTRSZ);
729 if((sfbeg(q) == 0) && ((c = sbackc(q))<0)) {
730 error("neg index\n");
733 error("index too big\n");
738 error("index too big\n");
745 if(length(p)-PTRSZ >= c*PTRSZ) {
749 q = copy(s,length(s));
755 q = salloc(1); /*so uninitialized array elt prints as 0*/
763 if((readptr != &readstk[0]) && (*readptr != 0)) {
764 if((*readptr)->rd == (*readptr)->wt)
767 if(readptr++ == &readstk[RDSKSZ]) {
768 error("nesting depth\n");
777 if((c = readc()) != '\n')
782 if(++readptr == &readstk[RDSKSZ]) {
783 error("nesting depth\n");
788 while((c = readc()) == '!')
792 while((c = readc()) != '\n') {
811 Bprint(&bout,"%o is unimplemented\n",c);
817 div(Blk *ddivd, Blk *ddivr)
819 int divsign, remsign, offset, divcarry,
820 carry, dig, magic, d, dd, under, first;
822 Blk *ps, *px, *p, *divd, *divr;
829 if(length(ddivr) == 0) {
831 Bprint(&bout,"divide by 0\n");
834 divsign = remsign = first = 0;
837 if(sbackc(divr) == -1) {
838 divr = copy(ddivr,length(ddivr));
842 divd = copy(ddivd,length(ddivd));
844 if(sfbeg(divd) == 0 && sbackc(divd) == -1) {
849 offset = length(divd) - length(divr);
859 c = c * 100 + (sfbeg(divr)?0:sbackc(divr));
861 c = (c * 100 +(sfbeg(divr)?0:sbackc(divr)))*2;
867 td = sbackc(divd) * 100;
868 dd = sfbeg(divd)?0:sbackc(divd);
869 td = (td + dd) * 100;
870 dd = sfbeg(divd)?0:sbackc(divd);
881 if(td%cc < 8 && dig > 0 && magic) {
888 while(sfeof(divr) == 0) {
889 d = sgetc(divr)*dig+carry;
891 salterc(divxyz,d%100);
893 salterc(divxyz,carry);
897 while(sfeof(divd) == 0) {
899 d = d-(sfeof(divxyz)?0:sgetc(divxyz))-carry;
913 if((d != 0) && /*!divcarry*/ (offset != 0)) {
914 d = sbackc(divd) + 100;
920 if(under) { /* undershot last - adjust*/
921 px = copy(divr,length(divr)); /*11/88 don't corrupt ddivr*/
925 if(length(ps) > 0 && sbackc(ps) < 0) {
926 release(ps); /*only adjust in really undershot*/
943 while(sfeof(p) == 0){
944 d = slookc(p)+divcarry;
952 if(divcarry != 0)salterc(p,divcarry);
954 while(sfbeg(p) == 0) {
962 while(sfbeg(divd) == 0) {
963 if(sbackc(divd) != 0)
990 if(sfbeg(dr) == 1 || (sfbeg(dr) == 0 && sbackc(dr) == 0)) {
993 Bprint(&bout,"divide by 0\n");
996 if(sfbeg(dd) == 1 || (sfbeg(dd) == 0 && sbackc(dd) == 0)) {
1015 removr(Blk *p, int n)
1032 while(sfeof(p) == 0)
1040 sputc(q,sgetc(rem));
1071 c = c*100+(sfbeg(p)?0:sbackc(p));
1096 s = copy(r,length(r));
1101 nn = sfbeg(t)?0:sbackc(t);
1115 dcexp(Blk *base, Blk *ex)
1117 Blk *r, *e, *p, *e1, *t, *cp;
1122 p = copy(base,length(base));
1123 e = copy(ex,length(ex));
1133 while(length(e) != 0) {
1144 t = copy(p,length(p));
1151 if((c = length(base)) == 0) {
1158 if((c = sgetc(base))<=1) {
1172 init(int argc, char *argv[])
1187 fprint(2, "dc: can't open file %s\n", *argv);
1190 if(d->mode & DMDIR) {
1191 fprint(2, "dc: file %s is a directory\n", *argv);
1195 if((curfile = Bopen(*argv, OREAD)) == 0) {
1196 fprint(2,"dc: can't open file %s\n", *argv);
1200 /* dummy = malloc(0); /* prepare for garbage-collection */
1201 scalptr = salloc(1);
1220 stkbeg = stkptr = &stack[0];
1221 stkend = &stack[STKSZ];
1223 readptr = &readstk[0];
1225 sp = sptr = &symlst[0];
1226 while(sptr < &symlst[TBLSZ-1]) {
1237 if(stkptr == stkend) {
1238 Bprint(&bout,"out of stack space\n");
1249 if(stkptr == stack) {
1276 if(c >= 'A' && c <= 'F')
1279 if(c >= '0' && c <= '9')
1309 * returns pointer to struct with ct 0's & p
1312 add0(Blk *p, int ct)
1316 q = salloc(length(p)+(ct+1)/2);
1322 while(sfeof(p) == 0) {
1335 mult(Blk *p, Blk *q)
1338 int sign, offset, carry;
1339 int cq, cp, mt, mcr;
1346 mp = copy(p,length(p));
1355 mq = copy(q,length(q));
1360 mr = salloc(length(mp)+length(mq));
1363 while(sfeof(mq) == 0) {
1369 while(sfeof(mp) == 0) {
1371 mcr = sfeof(mr)?0:slookc(mr);
1372 mt = cp*cq + carry + mcr;
1378 mcr = sfeof(mr)?0:slookc(mr);
1379 salterc(mr,mcr+carry);
1400 while(sfeof(p) == 0) {
1401 ct=100-slookc(p)-carry;
1414 if(ct == 99 /*&& !sfbeg(p)*/) {
1431 if((readptr != &readstk[0]) && (*readptr != 0)) {
1432 if(sfeof(*readptr) == 0)
1433 return(lastchar = sgetc(*readptr));
1438 lastchar = Bgetc(curfile);
1441 if(readptr != &readptr[0]) {
1447 if(curfile != &bin) {
1453 return 0; /* shut up ken */
1460 if((readptr != &readstk[0]) && (*readptr != 0)) {
1461 sungetc(*readptr,c);
1478 r = mult(arg1,arg2);
1494 int dig, dout, ct, sc;
1497 while(sfeof(hptr) == 0) {
1498 if(sgetc(hptr)>99) {
1500 while(sfeof(hptr) == 0) {
1501 Bprint(&bout,"%c",sgetc(hptr));
1509 if(sfbeg(hptr) != 0) {
1510 Bprint(&bout,"0\n");
1514 p = copy(hptr,length(hptr));
1521 if((obase == 0) || (obase == -1)) {
1533 /* sleazy hack to scale top of stack - divide by 1 */
1543 p = div(arg1, arg2);
1550 dout = ((dig/10) + dig) / logo;
1553 while(length(p) != 0) {
1561 while(sfbeg(strptr) == 0)
1562 OUTC(sbackc(strptr));
1572 q = mult(basptr,dec);
1577 } while(++ct < dout);
1580 while(sfeof(strptr) == 0)
1581 OUTC(sgetc(strptr));
1586 getdec(Blk *p, int sc)
1592 if(length(p)*2 < sc) {
1593 q = copy(p,length(p));
1596 q = salloc(length(p));
1603 s = salloc(cc = length(q));
1619 tenot(Blk *p, int sc)
1625 while((sfbeg(p) == 0) && ((p->rd-p->beg-1)*2 >= sc)) {
1627 if((c<10) && (f == 1))
1628 Bprint(&bout,"0%d",c);
1630 Bprint(&bout,"%d",c);
1639 if((p->rd-p->beg)*2 > sc) {
1641 Bprint(&bout,"%d.",c/10);
1648 while(sc>(p->rd-p->beg)*2) {
1655 Bprint(&bout,"0%d",c);
1657 Bprint(&bout,"%d",c);
1662 OUTC(sbackc(p)/10 +'0');
1669 oneot(Blk *p, int sc, char ch)
1676 while(length(q)>0) {
1687 hexot(Blk *p, int flg)
1701 Bprint(&bout,"hex digit > 16");
1704 sputc(strptr,c<10?c+'0':c-10+'a');
1708 bigot(Blk *p, int flg)
1718 l = length(strptr)+fw-1;
1721 if(length(p) != 0) {
1727 while(length(p) != 0) {
1732 sputc(t,sfeof(rem)?'0':sgetc(rem)+'0');
1746 while(sfbeg(t) == 0)
1747 sputc(strptr,sbackc(t));
1750 l -= length(strptr);
1762 add(Blk *a1, Blk *a2)
1765 int carry, n, size, c, n1, n2;
1767 size = length(a1)>length(a2)?length(a1):length(a2);
1772 while(--size >= 0) {
1773 n1 = sfeof(a1)?0:sgetc(a1);
1774 n2 = sfeof(a2)?0:sgetc(a2);
1775 n = n1 + n2 + carry;
1792 while(sfbeg(p) == 0 && (c = sbackc(p)) == 0)
1799 if(sfbeg(p) == 0 && sbackc(p) == -1) {
1800 while((c = sbackc(p)) == 99) {
1831 p = add0(p,skq-skp);
1834 q = add0(q,skp-skq);
1842 removc(Blk *p, int n)
1852 while(sfeof(p) == 0)
1875 scale(Blk *p, int n)
1897 savk = sunputc(arg1);
1910 char line[100], *sl;
1913 switch(c = readc()) {
1923 while((c = readc()) != '\n')
1926 if((pid = fork()) == 0) {
1927 execl("/bin/rc","rc","-c",line,nil);
1931 if((p = waitpid()) < 0)
1936 Bprint(&bout,"!\n");
1951 if(length(p) == 0) {
1953 if(c == '<' || c == '>' || c == NE) {
1973 if((cc<0 && (c == '<' || c == NG)) ||
1974 (cc >0) && (c == '>' || c == NL)) {
1988 c = getstk() & 0377;
1993 q = salloc(length(p));
1995 while(sfeof(p) == 0) {
2000 t = copy(s,length(s));
2006 q = copy(p,length(p));
2012 Bprint(&bout,"function %c undefined\n",c+'a'-1);
2035 while((n <<= 1) > 0)
2048 if(all - rel > active)
2056 ptr = malloc((unsigned)size);
2059 if((ptr = malloc((unsigned)size)) == 0)
2062 if((hdr = hfree) == 0)
2064 hfree = (Blk *)hdr->rd;
2065 hdr->rd = hdr->wt = hdr->beg = ptr;
2066 hdr->last = ptr+size;
2077 hfree = h = (Blk *)malloc(HEADSZ);
2080 if((hfree = h = (Blk*)malloc(HEADSZ)) == 0)
2084 while(h<hfree+(HEADSZ/BLK))
2085 (h++)->rd = (char*)++kk;
2091 copy(Blk *hptr, int size)
2109 Bprint(&bout,"copy size %d\n",size);
2112 memmove(ptr, hptr->beg, sz);
2114 memset(ptr+sz, 0, size-sz);
2115 if((hdr = hfree) == 0)
2117 hfree = (Blk *)hdr->rd;
2118 hdr->rd = hdr->beg = ptr;
2119 hdr->last = ptr+size;
2122 while(ptr<hdr->last)
2128 sdump(char *s1, Blk *hptr)
2133 Bprint(&bout, "%s no block\n", s1);
2136 Bprint(&bout,"%s %lx rd %lx wt %lx beg %lx last %lx\n",
2137 s1,hptr,hptr->rd,hptr->wt,hptr->beg,hptr->last);
2140 Bprint(&bout,"%d ",*p++);
2145 seekc(Blk *hptr, int n)
2150 if(nn > hptr->last) {
2151 nbytes += nn - hptr->last;
2152 if(nbytes > maxsize)
2154 lbytes += nn - hptr->last;
2157 /* free(hptr->beg); /**/
2158 p = realloc(hptr->beg, n);
2160 /* hptr->beg = realloc(hptr->beg, hptr->last-hptr->beg);
2161 ** garbage("seekc");
2162 ** if((p = realloc(hptr->beg, n)) == 0)
2166 hptr->wt = hptr->last = hptr->rd = p+n;
2175 salterwd(Blk *ahptr, Blk *n)
2179 hptr = (Wblk*)ahptr;
2180 if(hptr->rdw == hptr->lastw)
2183 if(hptr->rdw > hptr->wtw)
2184 hptr->wtw = hptr->rdw;
2193 if((size=(hptr->last-hptr->beg)*2) == 0)
2196 if(nbytes > maxsize)
2202 /* free(hptr->beg);/**/
2203 p = realloc(hptr->beg, size);
2206 /* hptr->beg = realloc(hptr->beg, (hptr->last-hptr->beg));
2208 ** if((p = realloc(hptr->beg,size)) == 0)
2211 hptr->rd = p + (hptr->rd - hptr->beg);
2212 hptr->wt = p + (hptr->wt - hptr->beg);
2214 hptr->last = p+size;
2220 Bprint(&bout,"out of space: %s\n",s);
2221 Bprint(&bout,"all %ld rel %ld headmor %ld\n",all,rel,headmor);
2222 Bprint(&bout,"nbytes %ld\n",nbytes);
2223 sdump("stk",*stkptr);
2238 nbytes -= p->last - p->beg;
2239 p->rd = (char*)hfree;
2250 if(wp->rdw == wp->wtw)
2256 putwd(Blk *p, Blk *c)
2261 if(wp->wtw == wp->lastw)
2272 if(wp->rdw == wp->wtw)