Blob
1 #include <u.h>2 #include <libc.h>3 #include <bio.h>5 typedef void* pointer;7 #define div dcdiv9 #define FATAL 010 #define NFATAL 111 #define BLK sizeof(Blk)12 #define PTRSZ sizeof(int*)13 #define HEADSZ 102414 #define STKSZ 10015 #define RDSKSZ 10016 #define TBLSZ 25617 #define ARRAYST 22118 #define MAXIND 204819 #define NL 120 #define NG 221 #define NE 322 #define length(p) ((p)->wt-(p)->beg)23 #define rewind(p) (p)->rd=(p)->beg24 #undef create25 #define create(p) (p)->rd = (p)->wt = (p)->beg26 #define fsfile(p) (p)->rd = (p)->wt27 #define truncate(p) (p)->wt = (p)->rd28 #define sfeof(p) (((p)->rd==(p)->wt)?1:0)29 #define sfbeg(p) (((p)->rd==(p)->beg)?1:0)30 #define sungetc(p,c) *(--(p)->rd)=c31 #define sgetc(p) (((p)->rd==(p)->wt)?-1:*(p)->rd++)32 #define skipc(p) {if((p)->rd<(p)->wt)(p)->rd++;}33 #define slookc(p) (((p)->rd==(p)->wt)?-1:*(p)->rd)34 #define sbackc(p) (((p)->rd==(p)->beg)?-1:*(--(p)->rd))35 #define backc(p) {if((p)->rd>(p)->beg) --(p)->rd;}36 #define sputc(p,c) {if((p)->wt==(p)->last)more(p);\37 *(p)->wt++ = c; }38 #define salterc(p,c) {if((p)->rd==(p)->last)more(p);\39 *(p)->rd++ = c;\40 if((p)->rd>(p)->wt)(p)->wt=(p)->rd;}41 #define sunputc(p) (*((p)->rd = --(p)->wt))42 #define sclobber(p) ((p)->rd = --(p)->wt)43 #define zero(p) for(pp=(p)->beg;pp<(p)->last;)\44 *pp++='\0'45 #define OUTC(x) {Bputc(&bout,x); if(--count == 0){Bprint(&bout,"\\\n"); count=ll;} }46 #define TEST2 {if((count -= 2) <=0){Bprint(&bout,"\\\n");count=ll;}}47 #define EMPTY if(stkerr != 0){Bprint(&bout,"stack empty\n"); continue; }48 #define EMPTYR(x) if(stkerr!=0){pushp(x);Bprint(&bout,"stack empty\n");continue;}49 #define EMPTYS if(stkerr != 0){Bprint(&bout,"stack empty\n"); return(1);}50 #define EMPTYSR(x) if(stkerr !=0){Bprint(&bout,"stack empty\n");pushp(x);return(1);}51 #define error(p) {Bprint(&bout,p); continue; }52 #define errorrt(p) {Bprint(&bout,p); return(1); }53 #define LASTFUN 02655 typedef struct Blk Blk;56 struct Blk57 {58 char *rd;59 char *wt;60 char *beg;61 char *last;62 };63 typedef struct Sym Sym;64 struct Sym65 {66 Sym *next;67 Blk *val;68 };69 typedef struct Wblk Wblk;70 struct Wblk71 {72 Blk **rdw;73 Blk **wtw;74 Blk **begw;75 Blk **lastw;76 };78 Biobuf *curfile, *fsave;79 Blk *arg1, *arg2;80 uchar savk;81 int dbg;82 int ifile;83 Blk *scalptr, *basptr, *tenptr, *inbas;84 Blk *sqtemp, *chptr, *strptr, *divxyz;85 Blk *stack[STKSZ];86 Blk **stkptr,**stkbeg;87 Blk **stkend;88 Blk *hfree;89 int stkerr;90 int lastchar;91 Blk *readstk[RDSKSZ];92 Blk **readptr;93 Blk *rem;94 int k;95 Blk *irem;96 int skd,skr;97 int neg;98 Sym symlst[TBLSZ];99 Sym *stable[TBLSZ];100 Sym *sptr, *sfree;101 long rel;102 long nbytes;103 long all;104 long headmor;105 long obase;106 int fw,fw1,ll;107 void (*outdit)(Blk *p, int flg);108 int logo;109 int logten;110 int count;111 char *pp;112 char *dummy;113 long longest, maxsize, active;114 int lall, lrel, lcopy, lmore, lbytes;115 int inside;116 Biobuf bin;117 Biobuf bout;119 void main(int argc, char *argv[]);120 void commnds(void);121 Blk* readin(void);122 Blk* div(Blk *ddivd, Blk *ddivr);123 int dscale(void);124 Blk* removr(Blk *p, int n);125 Blk* dcsqrt(Blk *p);126 void init(int argc, char *argv[]);127 void onintr(void);128 void pushp(Blk *p);129 Blk* pop(void);130 Blk* readin(void);131 Blk* add0(Blk *p, int ct);132 Blk* mult(Blk *p, Blk *q);133 void chsign(Blk *p);134 int readc(void);135 void unreadc(char c);136 void binop(char c);137 void dcprint(Blk *hptr);138 Blk* dcexp(Blk *base, Blk *ex);139 Blk* getdec(Blk *p, int sc);140 void tenot(Blk *p, int sc);141 void oneot(Blk *p, int sc, char ch);142 void hexot(Blk *p, int flg);143 void bigot(Blk *p, int flg);144 Blk* add(Blk *a1, Blk *a2);145 int eqk(void);146 Blk* removc(Blk *p, int n);147 Blk* scalint(Blk *p);148 Blk* scale(Blk *p, int n);149 int subt(void);150 int command(void);151 int cond(char c);152 void load(void);153 #define log2 dclog2154 int log2(long n);155 Blk* salloc(int size);156 Blk* morehd(void);157 Blk* copy(Blk *hptr, int size);158 void sdump(char *s1, Blk *hptr);159 void seekc(Blk *hptr, int n);160 void salterwd(Blk *hptr, Blk *n);161 void more(Blk *hptr);162 void ospace(char *s);163 void garbage(char *s);164 void release(Blk *p);165 Blk* dcgetwd(Blk *p);166 void putwd(Blk *p, Blk *c);167 Blk* lookwd(Blk *p);168 char* nalloc(char *p, unsigned nbytes);169 int getstk(void);171 /********debug only**/172 void173 tpr(char *cp, Blk *bp)174 {175 print("%s-> ", cp);176 print("beg: %lx rd: %lx wt: %lx last: %lx\n", bp->beg, bp->rd,177 bp->wt, bp->last);178 for (cp = bp->beg; cp != bp->wt; cp++) {179 print("%d", *cp);180 if (cp != bp->wt-1)181 print("/");182 }183 print("\n");184 }185 /************/187 void188 main(int argc, char *argv[])189 {190 Binit(&bin, 0, OREAD);191 Binit(&bout, 1, OWRITE);192 init(argc,argv);193 commnds();194 exits(0);195 }197 void198 commnds(void)199 {200 Blk *p, *q, **ptr, *s, *t;201 long l;202 Sym *sp;203 int sk, sk1, sk2, c, sign, n, d;205 while(1) {206 Bflush(&bout);207 if(((c = readc())>='0' && c <= '9') ||208 (c>='A' && c <='F') || c == '.') {209 unreadc(c);210 p = readin();211 pushp(p);212 continue;213 }214 switch(c) {215 case ' ':216 case '\n':217 case -1:218 continue;219 case 'Y':220 sdump("stk",*stkptr);221 Bprint(&bout, "all %ld rel %ld headmor %ld\n",all,rel,headmor);222 Bprint(&bout, "nbytes %ld\n",nbytes);223 Bprint(&bout, "longest %ld active %ld maxsize %ld\n", longest,224 active, maxsize);225 Bprint(&bout, "new all %d rel %d copy %d more %d lbytes %d\n",226 lall, lrel, lcopy, lmore, lbytes);227 lall = lrel = lcopy = lmore = lbytes = 0;228 continue;229 case '_':230 p = readin();231 savk = sunputc(p);232 chsign(p);233 sputc(p,savk);234 pushp(p);235 continue;236 case '-':237 subt();238 continue;239 case '+':240 if(eqk() != 0)241 continue;242 binop('+');243 continue;244 case '*':245 arg1 = pop();246 EMPTY;247 arg2 = pop();248 EMPTYR(arg1);249 sk1 = sunputc(arg1);250 sk2 = sunputc(arg2);251 savk = sk1+sk2;252 binop('*');253 p = pop();254 if(savk>k && savk>sk1 && savk>sk2) {255 sclobber(p);256 sk = sk1;257 if(sk<sk2)258 sk = sk2;259 if(sk<k)260 sk = k;261 p = removc(p,savk-sk);262 savk = sk;263 sputc(p,savk);264 }265 pushp(p);266 continue;267 case '/':268 casediv:269 if(dscale() != 0)270 continue;271 binop('/');272 if(irem != 0)273 release(irem);274 release(rem);275 continue;276 case '%':277 if(dscale() != 0)278 continue;279 binop('/');280 p = pop();281 release(p);282 if(irem == 0) {283 sputc(rem,skr+k);284 pushp(rem);285 continue;286 }287 p = add0(rem,skd-(skr+k));288 q = add(p,irem);289 release(p);290 release(irem);291 sputc(q,skd);292 pushp(q);293 continue;294 case 'v':295 p = pop();296 EMPTY;297 savk = sunputc(p);298 if(length(p) == 0) {299 sputc(p,savk);300 pushp(p);301 continue;302 }303 if(sbackc(p)<0) {304 error("sqrt of neg number\n");305 }306 if(k<savk)307 n = savk;308 else {309 n = k*2-savk;310 savk = k;311 }312 arg1 = add0(p,n);313 arg2 = dcsqrt(arg1);314 sputc(arg2,savk);315 pushp(arg2);316 continue;318 case '^':319 neg = 0;320 arg1 = pop();321 EMPTY;322 if(sunputc(arg1) != 0)323 error("exp not an integer\n");324 arg2 = pop();325 EMPTYR(arg1);326 if(sfbeg(arg1) == 0 && sbackc(arg1)<0) {327 neg++;328 chsign(arg1);329 }330 if(length(arg1)>=3) {331 error("exp too big\n");332 }333 savk = sunputc(arg2);334 p = dcexp(arg2,arg1);335 release(arg2);336 rewind(arg1);337 c = sgetc(arg1);338 if(c == -1)339 c = 0;340 else341 if(sfeof(arg1) == 0)342 c = sgetc(arg1)*100 + c;343 d = c*savk;344 release(arg1);345 /* if(neg == 0) { removed to fix -exp bug*/346 if(k>=savk)347 n = k;348 else349 n = savk;350 if(n<d) {351 q = removc(p,d-n);352 sputc(q,n);353 pushp(q);354 } else {355 sputc(p,d);356 pushp(p);357 }358 /* } else { this is disaster for exp <-127 */359 /* sputc(p,d); */360 /* pushp(p); */361 /* } */362 if(neg == 0)363 continue;364 p = pop();365 q = salloc(2);366 sputc(q,1);367 sputc(q,0);368 pushp(q);369 pushp(p);370 goto casediv;371 case 'z':372 p = salloc(2);373 n = stkptr - stkbeg;374 if(n >= 100) {375 sputc(p,n/100);376 n %= 100;377 }378 sputc(p,n);379 sputc(p,0);380 pushp(p);381 continue;382 case 'Z':383 p = pop();384 EMPTY;385 n = (length(p)-1)<<1;386 fsfile(p);387 backc(p);388 if(sfbeg(p) == 0) {389 if((c = sbackc(p))<0) {390 n -= 2;391 if(sfbeg(p) == 1)392 n++;393 else {394 if((c = sbackc(p)) == 0)395 n++;396 else397 if(c > 90)398 n--;399 }400 } else401 if(c < 10)402 n--;403 }404 release(p);405 q = salloc(1);406 if(n >= 100) {407 sputc(q,n%100);408 n /= 100;409 }410 sputc(q,n);411 sputc(q,0);412 pushp(q);413 continue;414 case 'i':415 p = pop();416 EMPTY;417 p = scalint(p);418 release(inbas);419 inbas = p;420 continue;421 case 'I':422 p = copy(inbas,length(inbas)+1);423 sputc(p,0);424 pushp(p);425 continue;426 case 'o':427 p = pop();428 EMPTY;429 p = scalint(p);430 sign = 0;431 n = length(p);432 q = copy(p,n);433 fsfile(q);434 l = c = sbackc(q);435 if(n != 1) {436 if(c<0) {437 sign = 1;438 chsign(q);439 n = length(q);440 fsfile(q);441 l = c = sbackc(q);442 }443 if(n != 1) {444 while(sfbeg(q) == 0)445 l = l*100+sbackc(q);446 }447 }448 logo = log2(l);449 obase = l;450 release(basptr);451 if(sign == 1)452 obase = -l;453 basptr = p;454 outdit = bigot;455 if(n == 1 && sign == 0) {456 if(c <= 16) {457 outdit = hexot;458 fw = 1;459 fw1 = 0;460 ll = 70;461 release(q);462 continue;463 }464 }465 n = 0;466 if(sign == 1)467 n++;468 p = salloc(1);469 sputc(p,-1);470 t = add(p,q);471 n += length(t)*2;472 fsfile(t);473 if(sbackc(t)>9)474 n++;475 release(t);476 release(q);477 release(p);478 fw = n;479 fw1 = n-1;480 ll = 70;481 if(fw>=ll)482 continue;483 ll = (70/fw)*fw;484 continue;485 case 'O':486 p = copy(basptr,length(basptr)+1);487 sputc(p,0);488 pushp(p);489 continue;490 case '[':491 n = 0;492 p = salloc(0);493 for(;;) {494 if((c = readc()) == ']') {495 if(n == 0)496 break;497 n--;498 }499 sputc(p,c);500 if(c == '[')501 n++;502 }503 pushp(p);504 continue;505 case 'k':506 p = pop();507 EMPTY;508 p = scalint(p);509 if(length(p)>1) {510 error("scale too big\n");511 }512 rewind(p);513 k = 0;514 if(!sfeof(p))515 k = sgetc(p);516 release(scalptr);517 scalptr = p;518 continue;519 case 'K':520 p = copy(scalptr,length(scalptr)+1);521 sputc(p,0);522 pushp(p);523 continue;524 case 'X':525 p = pop();526 EMPTY;527 fsfile(p);528 n = sbackc(p);529 release(p);530 p = salloc(2);531 sputc(p,n);532 sputc(p,0);533 pushp(p);534 continue;535 case 'Q':536 p = pop();537 EMPTY;538 if(length(p)>2) {539 error("Q?\n");540 }541 rewind(p);542 if((c = sgetc(p))<0) {543 error("neg Q\n");544 }545 release(p);546 while(c-- > 0) {547 if(readptr == &readstk[0]) {548 error("readstk?\n");549 }550 if(*readptr != 0)551 release(*readptr);552 readptr--;553 }554 continue;555 case 'q':556 if(readptr <= &readstk[1])557 exits(0);558 if(*readptr != 0)559 release(*readptr);560 readptr--;561 if(*readptr != 0)562 release(*readptr);563 readptr--;564 continue;565 case 'f':566 if(stkptr == &stack[0])567 Bprint(&bout,"empty stack\n");568 else {569 for(ptr = stkptr; ptr > &stack[0];) {570 dcprint(*ptr--);571 }572 }573 continue;574 case 'p':575 if(stkptr == &stack[0])576 Bprint(&bout,"empty stack\n");577 else {578 dcprint(*stkptr);579 }580 continue;581 case 'P':582 p = pop();583 EMPTY;584 sputc(p,0);585 Bprint(&bout,"%s",p->beg);586 release(p);587 continue;588 case 'd':589 if(stkptr == &stack[0]) {590 Bprint(&bout,"empty stack\n");591 continue;592 }593 q = *stkptr;594 n = length(q);595 p = copy(*stkptr,n);596 pushp(p);597 continue;598 case 'c':599 while(stkerr == 0) {600 p = pop();601 if(stkerr == 0)602 release(p);603 }604 continue;605 case 'S':606 if(stkptr == &stack[0]) {607 error("save: args\n");608 }609 c = getstk() & 0377;610 sptr = stable[c];611 sp = stable[c] = sfree;612 sfree = sfree->next;613 if(sfree == 0)614 goto sempty;615 sp->next = sptr;616 p = pop();617 EMPTY;618 if(c >= ARRAYST) {619 q = copy(p,length(p)+PTRSZ);620 for(n = 0;n < PTRSZ;n++) {621 sputc(q,0);622 }623 release(p);624 p = q;625 }626 sp->val = p;627 continue;628 sempty:629 error("symbol table overflow\n");630 case 's':631 if(stkptr == &stack[0]) {632 error("save:args\n");633 }634 c = getstk() & 0377;635 sptr = stable[c];636 if(sptr != 0) {637 p = sptr->val;638 if(c >= ARRAYST) {639 rewind(p);640 while(sfeof(p) == 0)641 release(dcgetwd(p));642 }643 release(p);644 } else {645 sptr = stable[c] = sfree;646 sfree = sfree->next;647 if(sfree == 0)648 goto sempty;649 sptr->next = 0;650 }651 p = pop();652 sptr->val = p;653 continue;654 case 'l':655 load();656 continue;657 case 'L':658 c = getstk() & 0377;659 sptr = stable[c];660 if(sptr == 0) {661 error("L?\n");662 }663 stable[c] = sptr->next;664 sptr->next = sfree;665 sfree = sptr;666 p = sptr->val;667 if(c >= ARRAYST) {668 rewind(p);669 while(sfeof(p) == 0) {670 q = dcgetwd(p);671 if(q != 0)672 release(q);673 }674 }675 pushp(p);676 continue;677 case ':':678 p = pop();679 EMPTY;680 q = scalint(p);681 fsfile(q);682 c = 0;683 if((sfbeg(q) == 0) && ((c = sbackc(q))<0)) {684 error("neg index\n");685 }686 if(length(q)>2) {687 error("index too big\n");688 }689 if(sfbeg(q) == 0)690 c = c*100+sbackc(q);691 if(c >= MAXIND) {692 error("index too big\n");693 }694 release(q);695 n = getstk() & 0377;696 sptr = stable[n];697 if(sptr == 0) {698 sptr = stable[n] = sfree;699 sfree = sfree->next;700 if(sfree == 0)701 goto sempty;702 sptr->next = 0;703 p = salloc((c+PTRSZ)*PTRSZ);704 zero(p);705 } else {706 p = sptr->val;707 if(length(p)-PTRSZ < c*PTRSZ) {708 q = copy(p,(c+PTRSZ)*PTRSZ);709 release(p);710 p = q;711 }712 }713 seekc(p,c*PTRSZ);714 q = lookwd(p);715 if(q!=0)716 release(q);717 s = pop();718 EMPTY;719 salterwd(p, s);720 sptr->val = p;721 continue;722 case ';':723 p = pop();724 EMPTY;725 q = scalint(p);726 fsfile(q);727 c = 0;728 if((sfbeg(q) == 0) && ((c = sbackc(q))<0)) {729 error("neg index\n");730 }731 if(length(q)>2) {732 error("index too big\n");733 }734 if(sfbeg(q) == 0)735 c = c*100+sbackc(q);736 if(c >= MAXIND) {737 error("index too big\n");738 }739 release(q);740 n = getstk() & 0377;741 sptr = stable[n];742 if(sptr != 0){743 p = sptr->val;744 if(length(p)-PTRSZ >= c*PTRSZ) {745 seekc(p,c*PTRSZ);746 s = dcgetwd(p);747 if(s != 0) {748 q = copy(s,length(s));749 pushp(q);750 continue;751 }752 }753 }754 q = salloc(1); /*so uninitialized array elt prints as 0*/755 sputc(q, 0);756 pushp(q);757 continue;758 case 'x':759 execute:760 p = pop();761 EMPTY;762 if((readptr != &readstk[0]) && (*readptr != 0)) {763 if((*readptr)->rd == (*readptr)->wt)764 release(*readptr);765 else {766 if(readptr++ == &readstk[RDSKSZ]) {767 error("nesting depth\n");768 }769 }770 } else771 readptr++;772 *readptr = p;773 if(p != 0)774 rewind(p);775 else {776 if((c = readc()) != '\n')777 unreadc(c);778 }779 continue;780 case '?':781 if(++readptr == &readstk[RDSKSZ]) {782 error("nesting depth\n");783 }784 *readptr = 0;785 fsave = curfile;786 curfile = &bin;787 while((c = readc()) == '!')788 command();789 p = salloc(0);790 sputc(p,c);791 while((c = readc()) != '\n') {792 sputc(p,c);793 if(c == '\\')794 sputc(p,readc());795 }796 curfile = fsave;797 *readptr = p;798 continue;799 case '!':800 if(command() == 1)801 goto execute;802 continue;803 case '<':804 case '>':805 case '=':806 if(cond(c) == 1)807 goto execute;808 continue;809 default:810 Bprint(&bout,"%o is unimplemented\n",c);811 }812 }813 }815 Blk*816 div(Blk *ddivd, Blk *ddivr)817 {818 int divsign, remsign, offset, divcarry,819 carry, dig, magic, d, dd, under, first;820 long c, td, cc;821 Blk *ps, *px, *p, *divd, *divr;823 dig = 0;824 under = 0;825 divcarry = 0;826 rem = 0;827 p = salloc(0);828 if(length(ddivr) == 0) {829 pushp(ddivr);830 Bprint(&bout,"divide by 0\n");831 return(p);832 }833 divsign = remsign = first = 0;834 divr = ddivr;835 fsfile(divr);836 if(sbackc(divr) == -1) {837 divr = copy(ddivr,length(ddivr));838 chsign(divr);839 divsign = ~divsign;840 }841 divd = copy(ddivd,length(ddivd));842 fsfile(divd);843 if(sfbeg(divd) == 0 && sbackc(divd) == -1) {844 chsign(divd);845 divsign = ~divsign;846 remsign = ~remsign;847 }848 offset = length(divd) - length(divr);849 if(offset < 0)850 goto ddone;851 seekc(p,offset+1);852 sputc(divd,0);853 magic = 0;854 fsfile(divr);855 c = sbackc(divr);856 if(c < 10)857 magic++;858 c = c * 100 + (sfbeg(divr)?0:sbackc(divr));859 if(magic>0){860 c = (c * 100 +(sfbeg(divr)?0:sbackc(divr)))*2;861 c /= 25;862 }863 while(offset >= 0) {864 first++;865 fsfile(divd);866 td = sbackc(divd) * 100;867 dd = sfbeg(divd)?0:sbackc(divd);868 td = (td + dd) * 100;869 dd = sfbeg(divd)?0:sbackc(divd);870 td = td + dd;871 cc = c;872 if(offset == 0)873 td++;874 else875 cc++;876 if(magic != 0)877 td = td<<3;878 dig = td/cc;879 under=0;880 if(td%cc < 8 && dig > 0 && magic) {881 dig--;882 under=1;883 }884 rewind(divr);885 rewind(divxyz);886 carry = 0;887 while(sfeof(divr) == 0) {888 d = sgetc(divr)*dig+carry;889 carry = d / 100;890 salterc(divxyz,d%100);891 }892 salterc(divxyz,carry);893 rewind(divxyz);894 seekc(divd,offset);895 carry = 0;896 while(sfeof(divd) == 0) {897 d = slookc(divd);898 d = d-(sfeof(divxyz)?0:sgetc(divxyz))-carry;899 carry = 0;900 if(d < 0) {901 d += 100;902 carry = 1;903 }904 salterc(divd,d);905 }906 divcarry = carry;907 backc(p);908 salterc(p,dig);909 backc(p);910 fsfile(divd);911 d=sbackc(divd);912 if((d != 0) && /*!divcarry*/ (offset != 0)) {913 d = sbackc(divd) + 100;914 salterc(divd,d);915 }916 if(--offset >= 0)917 divd->wt--;918 }919 if(under) { /* undershot last - adjust*/920 px = copy(divr,length(divr)); /*11/88 don't corrupt ddivr*/921 chsign(px);922 ps = add(px,divd);923 fsfile(ps);924 if(length(ps) > 0 && sbackc(ps) < 0) {925 release(ps); /*only adjust in really undershot*/926 } else {927 release(divd);928 salterc(p, dig+1);929 divd=ps;930 }931 }932 if(divcarry != 0) {933 salterc(p,dig-1);934 salterc(divd,-1);935 ps = add(divr,divd);936 release(divd);937 divd = ps;938 }940 rewind(p);941 divcarry = 0;942 while(sfeof(p) == 0){943 d = slookc(p)+divcarry;944 divcarry = 0;945 if(d >= 100){946 d -= 100;947 divcarry = 1;948 }949 salterc(p,d);950 }951 if(divcarry != 0)salterc(p,divcarry);952 fsfile(p);953 while(sfbeg(p) == 0) {954 if(sbackc(p) != 0)955 break;956 truncate(p);957 }958 if(divsign < 0)959 chsign(p);960 fsfile(divd);961 while(sfbeg(divd) == 0) {962 if(sbackc(divd) != 0)963 break;964 truncate(divd);965 }966 ddone:967 if(remsign<0)968 chsign(divd);969 if(divr != ddivr)970 release(divr);971 rem = divd;972 return(p);973 }975 int976 dscale(void)977 {978 Blk *dd, *dr, *r;979 int c;981 dr = pop();982 EMPTYS;983 dd = pop();984 EMPTYSR(dr);985 fsfile(dd);986 skd = sunputc(dd);987 fsfile(dr);988 skr = sunputc(dr);989 if(sfbeg(dr) == 1 || (sfbeg(dr) == 0 && sbackc(dr) == 0)) {990 sputc(dr,skr);991 pushp(dr);992 Bprint(&bout,"divide by 0\n");993 return(1);994 }995 if(sfbeg(dd) == 1 || (sfbeg(dd) == 0 && sbackc(dd) == 0)) {996 sputc(dd,skd);997 pushp(dd);998 return(1);999 }1000 c = k-skd+skr;1001 if(c < 0)1002 r = removr(dd,-c);1003 else {1004 r = add0(dd,c);1005 irem = 0;1006 }1007 arg1 = r;1008 arg2 = dr;1009 savk = k;1010 return(0);1011 }1013 Blk*1014 removr(Blk *p, int n)1015 {1016 int nn, neg;1017 Blk *q, *s, *r;1019 fsfile(p);1020 neg = sbackc(p);1021 if(neg < 0)1022 chsign(p);1023 rewind(p);1024 nn = (n+1)/2;1025 q = salloc(nn);1026 while(n>1) {1027 sputc(q,sgetc(p));1028 n -= 2;1029 }1030 r = salloc(2);1031 while(sfeof(p) == 0)1032 sputc(r,sgetc(p));1033 release(p);1034 if(n == 1){1035 s = div(r,tenptr);1036 release(r);1037 rewind(rem);1038 if(sfeof(rem) == 0)1039 sputc(q,sgetc(rem));1040 release(rem);1041 if(neg < 0){1042 chsign(s);1043 chsign(q);1044 irem = q;1045 return(s);1046 }1047 irem = q;1048 return(s);1049 }1050 if(neg < 0) {1051 chsign(r);1052 chsign(q);1053 irem = q;1054 return(r);1055 }1056 irem = q;1057 return(r);1058 }1060 Blk*1061 dcsqrt(Blk *p)1062 {1063 Blk *t, *r, *q, *s;1064 int c, n, nn;1066 n = length(p);1067 fsfile(p);1068 c = sbackc(p);1069 if((n&1) != 1)1070 c = c*100+(sfbeg(p)?0:sbackc(p));1071 n = (n+1)>>1;1072 r = salloc(n);1073 zero(r);1074 seekc(r,n);1075 nn=1;1076 while((c -= nn)>=0)1077 nn+=2;1078 c=(nn+1)>>1;1079 fsfile(r);1080 backc(r);1081 if(c>=100) {1082 c -= 100;1083 salterc(r,c);1084 sputc(r,1);1085 } else1086 salterc(r,c);1087 for(;;){1088 q = div(p,r);1089 s = add(q,r);1090 release(q);1091 release(rem);1092 q = div(s,sqtemp);1093 release(s);1094 release(rem);1095 s = copy(r,length(r));1096 chsign(s);1097 t = add(s,q);1098 release(s);1099 fsfile(t);1100 nn = sfbeg(t)?0:sbackc(t);1101 if(nn>=0)1102 break;1103 release(r);1104 release(t);1105 r = q;1106 }1107 release(t);1108 release(q);1109 release(p);1110 return(r);1111 }1113 Blk*1114 dcexp(Blk *base, Blk *ex)1115 {1116 Blk *r, *e, *p, *e1, *t, *cp;1117 int temp, c, n;1119 r = salloc(1);1120 sputc(r,1);1121 p = copy(base,length(base));1122 e = copy(ex,length(ex));1123 fsfile(e);1124 if(sfbeg(e) != 0)1125 goto edone;1126 temp=0;1127 c = sbackc(e);1128 if(c<0) {1129 temp++;1130 chsign(e);1131 }1132 while(length(e) != 0) {1133 e1=div(e,sqtemp);1134 release(e);1135 e = e1;1136 n = length(rem);1137 release(rem);1138 if(n != 0) {1139 e1=mult(p,r);1140 release(r);1141 r = e1;1142 }1143 t = copy(p,length(p));1144 cp = mult(p,t);1145 release(p);1146 release(t);1147 p = cp;1148 }1149 if(temp != 0) {1150 if((c = length(base)) == 0) {1151 goto edone;1152 }1153 if(c>1)1154 create(r);1155 else {1156 rewind(base);1157 if((c = sgetc(base))<=1) {1158 create(r);1159 sputc(r,c);1160 } else1161 create(r);1162 }1163 }1164 edone:1165 release(p);1166 release(e);1167 return(r);1168 }1170 void1171 init(int argc, char *argv[])1172 {1173 Sym *sp;1174 Dir *d;1176 ARGBEGIN {1177 default:1178 dbg = 1;1179 break;1180 } ARGEND1181 ifile = 1;1182 curfile = &bin;1183 if(*argv){1184 d = dirstat(*argv);1185 if(d == nil) {1186 fprint(2, "dc: can't open file %s\n", *argv);1187 exits("open");1188 }1189 if(d->mode & DMDIR) {1190 fprint(2, "dc: file %s is a directory\n", *argv);1191 exits("open");1192 }1193 free(d);1194 if((curfile = Bopen(*argv, OREAD)) == 0) {1195 fprint(2,"dc: can't open file %s\n", *argv);1196 exits("open");1197 }1198 }1199 /* dummy = malloc(0); *//* prepare for garbage-collection */1200 scalptr = salloc(1);1201 sputc(scalptr,0);1202 basptr = salloc(1);1203 sputc(basptr,10);1204 obase=10;1205 logten=log2(10L);1206 ll=70;1207 fw=1;1208 fw1=0;1209 tenptr = salloc(1);1210 sputc(tenptr,10);1211 obase=10;1212 inbas = salloc(1);1213 sputc(inbas,10);1214 sqtemp = salloc(1);1215 sputc(sqtemp,2);1216 chptr = salloc(0);1217 strptr = salloc(0);1218 divxyz = salloc(0);1219 stkbeg = stkptr = &stack[0];1220 stkend = &stack[STKSZ];1221 stkerr = 0;1222 readptr = &readstk[0];1223 k=0;1224 sp = sptr = &symlst[0];1225 while(sptr < &symlst[TBLSZ]) {1226 sptr->next = ++sp;1227 sptr++;1228 }1229 sptr->next=0;1230 sfree = &symlst[0];1231 }1233 void1234 pushp(Blk *p)1235 {1236 if(stkptr == stkend) {1237 Bprint(&bout,"out of stack space\n");1238 return;1239 }1240 stkerr=0;1241 *++stkptr = p;1242 return;1243 }1245 Blk*1246 pop(void)1247 {1248 if(stkptr == stack) {1249 stkerr=1;1250 return(0);1251 }1252 return(*stkptr--);1253 }1255 Blk*1256 readin(void)1257 {1258 Blk *p, *q;1259 int dp, dpct, c;1261 dp = dpct=0;1262 p = salloc(0);1263 for(;;){1264 c = readc();1265 switch(c) {1266 case '.':1267 if(dp != 0)1268 goto gotnum;1269 dp++;1270 continue;1271 case '\\':1272 readc();1273 continue;1274 default:1275 if(c >= 'A' && c <= 'F')1276 c = c - 'A' + 10;1277 else1278 if(c >= '0' && c <= '9')1279 c -= '0';1280 else1281 goto gotnum;1282 if(dp != 0) {1283 if(dpct >= 99)1284 continue;1285 dpct++;1286 }1287 create(chptr);1288 if(c != 0)1289 sputc(chptr,c);1290 q = mult(p,inbas);1291 release(p);1292 p = add(chptr,q);1293 release(q);1294 }1295 }1296 gotnum:1297 unreadc(c);1298 if(dp == 0) {1299 sputc(p,0);1300 return(p);1301 } else {1302 q = scale(p,dpct);1303 return(q);1304 }1305 }1307 /*1308 * returns pointer to struct with ct 0's & p1309 */1310 Blk*1311 add0(Blk *p, int ct)1312 {1313 Blk *q, *t;1315 q = salloc(length(p)+(ct+1)/2);1316 while(ct>1) {1317 sputc(q,0);1318 ct -= 2;1319 }1320 rewind(p);1321 while(sfeof(p) == 0) {1322 sputc(q,sgetc(p));1323 }1324 release(p);1325 if(ct == 1) {1326 t = mult(tenptr,q);1327 release(q);1328 return(t);1329 }1330 return(q);1331 }1333 Blk*1334 mult(Blk *p, Blk *q)1335 {1336 Blk *mp, *mq, *mr;1337 int sign, offset, carry;1338 int cq, cp, mt, mcr;1340 offset = sign = 0;1341 fsfile(p);1342 mp = p;1343 if(sfbeg(p) == 0) {1344 if(sbackc(p)<0) {1345 mp = copy(p,length(p));1346 chsign(mp);1347 sign = ~sign;1348 }1349 }1350 fsfile(q);1351 mq = q;1352 if(sfbeg(q) == 0){1353 if(sbackc(q)<0) {1354 mq = copy(q,length(q));1355 chsign(mq);1356 sign = ~sign;1357 }1358 }1359 mr = salloc(length(mp)+length(mq));1360 zero(mr);1361 rewind(mq);1362 while(sfeof(mq) == 0) {1363 cq = sgetc(mq);1364 rewind(mp);1365 rewind(mr);1366 mr->rd += offset;1367 carry=0;1368 while(sfeof(mp) == 0) {1369 cp = sgetc(mp);1370 mcr = sfeof(mr)?0:slookc(mr);1371 mt = cp*cq + carry + mcr;1372 carry = mt/100;1373 salterc(mr,mt%100);1374 }1375 offset++;1376 if(carry != 0) {1377 mcr = sfeof(mr)?0:slookc(mr);1378 salterc(mr,mcr+carry);1379 }1380 }1381 if(sign < 0) {1382 chsign(mr);1383 }1384 if(mp != p)1385 release(mp);1386 if(mq != q)1387 release(mq);1388 return(mr);1389 }1391 void1392 chsign(Blk *p)1393 {1394 int carry;1395 char ct;1397 carry=0;1398 rewind(p);1399 while(sfeof(p) == 0) {1400 ct=100-slookc(p)-carry;1401 carry=1;1402 if(ct>=100) {1403 ct -= 100;1404 carry=0;1405 }1406 salterc(p,ct);1407 }1408 if(carry != 0) {1409 sputc(p,-1);1410 fsfile(p);1411 backc(p);1412 ct = sbackc(p);1413 if(ct == 99 /*&& !sfbeg(p)*/) {1414 truncate(p);1415 sputc(p,-1);1416 }1417 } else{1418 fsfile(p);1419 ct = sbackc(p);1420 if(ct == 0)1421 truncate(p);1422 }1423 return;1424 }1426 int1427 readc(void)1428 {1429 loop:1430 if((readptr != &readstk[0]) && (*readptr != 0)) {1431 if(sfeof(*readptr) == 0)1432 return(lastchar = sgetc(*readptr));1433 release(*readptr);1434 readptr--;1435 goto loop;1436 }1437 lastchar = Bgetc(curfile);1438 if(lastchar != -1)1439 return(lastchar);1440 if(readptr != &readptr[0]) {1441 readptr--;1442 if(*readptr == 0)1443 curfile = &bin;1444 goto loop;1445 }1446 if(curfile != &bin) {1447 Bterm(curfile);1448 curfile = &bin;1449 goto loop;1450 }1451 exits(0);1452 return 0; /* shut up ken */1453 }1455 void1456 unreadc(char c)1457 {1459 if((readptr != &readstk[0]) && (*readptr != 0)) {1460 sungetc(*readptr,c);1461 } else1462 Bungetc(curfile);1463 return;1464 }1466 void1467 binop(char c)1468 {1469 Blk *r;1471 r = 0;1472 switch(c) {1473 case '+':1474 r = add(arg1,arg2);1475 break;1476 case '*':1477 r = mult(arg1,arg2);1478 break;1479 case '/':1480 r = div(arg1,arg2);1481 break;1482 }1483 release(arg1);1484 release(arg2);1485 sputc(r,savk);1486 pushp(r);1487 }1489 void1490 dcprint(Blk *hptr)1491 {1492 Blk *p, *q, *dec;1493 int dig, dout, ct, sc;1495 rewind(hptr);1496 while(sfeof(hptr) == 0) {1497 if(sgetc(hptr)>99) {1498 rewind(hptr);1499 while(sfeof(hptr) == 0) {1500 Bprint(&bout,"%c",sgetc(hptr));1501 }1502 Bprint(&bout,"\n");1503 return;1504 }1505 }1506 fsfile(hptr);1507 sc = sbackc(hptr);1508 if(sfbeg(hptr) != 0) {1509 Bprint(&bout,"0\n");1510 return;1511 }1512 count = ll;1513 p = copy(hptr,length(hptr));1514 sclobber(p);1515 fsfile(p);1516 if(sbackc(p)<0) {1517 chsign(p);1518 OUTC('-');1519 }1520 if((obase == 0) || (obase == -1)) {1521 oneot(p,sc,'d');1522 return;1523 }1524 if(obase == 1) {1525 oneot(p,sc,'1');1526 return;1527 }1528 if(obase == 10) {1529 tenot(p,sc);1530 return;1531 }1532 /* sleazy hack to scale top of stack - divide by 1 */1533 pushp(p);1534 sputc(p, sc);1535 p=salloc(0);1536 create(p);1537 sputc(p, 1);1538 sputc(p, 0);1539 pushp(p);1540 if(dscale() != 0)1541 return;1542 p = div(arg1, arg2);1543 release(arg1);1544 release(arg2);1545 sc = savk;1547 create(strptr);1548 dig = logten*sc;1549 dout = ((dig/10) + dig) / logo;1550 dec = getdec(p,sc);1551 p = removc(p,sc);1552 while(length(p) != 0) {1553 q = div(p,basptr);1554 release(p);1555 p = q;1556 (*outdit)(rem,0);1557 }1558 release(p);1559 fsfile(strptr);1560 while(sfbeg(strptr) == 0)1561 OUTC(sbackc(strptr));1562 if(sc == 0) {1563 release(dec);1564 Bprint(&bout,"\n");1565 return;1566 }1567 create(strptr);1568 OUTC('.');1569 ct=0;1570 do {1571 q = mult(basptr,dec);1572 release(dec);1573 dec = getdec(q,sc);1574 p = removc(q,sc);1575 (*outdit)(p,1);1576 } while(++ct < dout);1577 release(dec);1578 rewind(strptr);1579 while(sfeof(strptr) == 0)1580 OUTC(sgetc(strptr));1581 Bprint(&bout,"\n");1582 }1584 Blk*1585 getdec(Blk *p, int sc)1586 {1587 int cc;1588 Blk *q, *t, *s;1590 rewind(p);1591 if(length(p)*2 < sc) {1592 q = copy(p,length(p));1593 return(q);1594 }1595 q = salloc(length(p));1596 while(sc >= 1) {1597 sputc(q,sgetc(p));1598 sc -= 2;1599 }1600 if(sc != 0) {1601 t = mult(q,tenptr);1602 s = salloc(cc = length(q));1603 release(q);1604 rewind(t);1605 while(cc-- > 0)1606 sputc(s,sgetc(t));1607 sputc(s,0);1608 release(t);1609 t = div(s,tenptr);1610 release(s);1611 release(rem);1612 return(t);1613 }1614 return(q);1615 }1617 void1618 tenot(Blk *p, int sc)1619 {1620 int c, f;1622 fsfile(p);1623 f=0;1624 while((sfbeg(p) == 0) && ((p->rd-p->beg-1)*2 >= sc)) {1625 c = sbackc(p);1626 if((c<10) && (f == 1))1627 Bprint(&bout,"0%d",c);1628 else1629 Bprint(&bout,"%d",c);1630 f=1;1631 TEST2;1632 }1633 if(sc == 0) {1634 Bprint(&bout,"\n");1635 release(p);1636 return;1637 }1638 if((p->rd-p->beg)*2 > sc) {1639 c = sbackc(p);1640 Bprint(&bout,"%d.",c/10);1641 TEST2;1642 OUTC(c%10 +'0');1643 sc--;1644 } else {1645 OUTC('.');1646 }1647 while(sc>(p->rd-p->beg)*2) {1648 OUTC('0');1649 sc--;1650 }1651 while(sc > 1) {1652 c = sbackc(p);1653 if(c<10)1654 Bprint(&bout,"0%d",c);1655 else1656 Bprint(&bout,"%d",c);1657 sc -= 2;1658 TEST2;1659 }1660 if(sc == 1) {1661 OUTC(sbackc(p)/10 +'0');1662 }1663 Bprint(&bout,"\n");1664 release(p);1665 }1667 void1668 oneot(Blk *p, int sc, char ch)1669 {1670 Blk *q;1672 q = removc(p,sc);1673 create(strptr);1674 sputc(strptr,-1);1675 while(length(q)>0) {1676 p = add(strptr,q);1677 release(q);1678 q = p;1679 OUTC(ch);1680 }1681 release(q);1682 Bprint(&bout,"\n");1683 }1685 void1686 hexot(Blk *p, int flg)1687 {1688 int c;1690 USED(flg);1691 rewind(p);1692 if(sfeof(p) != 0) {1693 sputc(strptr,'0');1694 release(p);1695 return;1696 }1697 c = sgetc(p);1698 release(p);1699 if(c >= 16) {1700 Bprint(&bout,"hex digit > 16");1701 return;1702 }1703 sputc(strptr,c<10?c+'0':c-10+'a');1704 }1706 void1707 bigot(Blk *p, int flg)1708 {1709 Blk *t, *q;1710 int neg, l;1712 if(flg == 1) {1713 t = salloc(0);1714 l = 0;1715 } else {1716 t = strptr;1717 l = length(strptr)+fw-1;1718 }1719 neg=0;1720 if(length(p) != 0) {1721 fsfile(p);1722 if(sbackc(p)<0) {1723 neg=1;1724 chsign(p);1725 }1726 while(length(p) != 0) {1727 q = div(p,tenptr);1728 release(p);1729 p = q;1730 rewind(rem);1731 sputc(t,sfeof(rem)?'0':sgetc(rem)+'0');1732 release(rem);1733 }1734 }1735 release(p);1736 if(flg == 1) {1737 l = fw1-length(t);1738 if(neg != 0) {1739 l--;1740 sputc(strptr,'-');1741 }1742 fsfile(t);1743 while(l-- > 0)1744 sputc(strptr,'0');1745 while(sfbeg(t) == 0)1746 sputc(strptr,sbackc(t));1747 release(t);1748 } else {1749 l -= length(strptr);1750 while(l-- > 0)1751 sputc(strptr,'0');1752 if(neg != 0) {1753 sclobber(strptr);1754 sputc(strptr,'-');1755 }1756 }1757 sputc(strptr,' ');1758 }1760 Blk*1761 add(Blk *a1, Blk *a2)1762 {1763 Blk *p;1764 int carry, n, size, c, n1, n2;1766 size = length(a1)>length(a2)?length(a1):length(a2);1767 p = salloc(size);1768 rewind(a1);1769 rewind(a2);1770 carry=0;1771 while(--size >= 0) {1772 n1 = sfeof(a1)?0:sgetc(a1);1773 n2 = sfeof(a2)?0:sgetc(a2);1774 n = n1 + n2 + carry;1775 if(n>=100) {1776 carry=1;1777 n -= 100;1778 } else1779 if(n<0) {1780 carry = -1;1781 n += 100;1782 } else1783 carry = 0;1784 sputc(p,n);1785 }1786 if(carry != 0)1787 sputc(p,carry);1788 fsfile(p);1789 if(sfbeg(p) == 0) {1790 c = 0;1791 while(sfbeg(p) == 0 && (c = sbackc(p)) == 0)1792 ;1793 if(c != 0)1794 salterc(p,c);1795 truncate(p);1796 }1797 fsfile(p);1798 if(sfbeg(p) == 0 && sbackc(p) == -1) {1799 while((c = sbackc(p)) == 99) {1800 if(c == -1)1801 break;1802 }1803 skipc(p);1804 salterc(p,-1);1805 truncate(p);1806 }1807 return(p);1808 }1810 int1811 eqk(void)1812 {1813 Blk *p, *q;1814 int skp, skq;1816 p = pop();1817 EMPTYS;1818 q = pop();1819 EMPTYSR(p);1820 skp = sunputc(p);1821 skq = sunputc(q);1822 if(skp == skq) {1823 arg1=p;1824 arg2=q;1825 savk = skp;1826 return(0);1827 }1828 if(skp < skq) {1829 savk = skq;1830 p = add0(p,skq-skp);1831 } else {1832 savk = skp;1833 q = add0(q,skp-skq);1834 }1835 arg1=p;1836 arg2=q;1837 return(0);1838 }1840 Blk*1841 removc(Blk *p, int n)1842 {1843 Blk *q, *r;1845 rewind(p);1846 while(n>1) {1847 skipc(p);1848 n -= 2;1849 }1850 q = salloc(2);1851 while(sfeof(p) == 0)1852 sputc(q,sgetc(p));1853 if(n == 1) {1854 r = div(q,tenptr);1855 release(q);1856 release(rem);1857 q = r;1858 }1859 release(p);1860 return(q);1861 }1863 Blk*1864 scalint(Blk *p)1865 {1866 int n;1868 n = sunputc(p);1869 p = removc(p,n);1870 return(p);1871 }1873 Blk*1874 scale(Blk *p, int n)1875 {1876 Blk *q, *s, *t;1878 t = add0(p,n);1879 q = salloc(1);1880 sputc(q,n);1881 s = dcexp(inbas,q);1882 release(q);1883 q = div(t,s);1884 release(t);1885 release(s);1886 release(rem);1887 sputc(q,n);1888 return(q);1889 }1891 int1892 subt(void)1893 {1894 arg1=pop();1895 EMPTYS;1896 savk = sunputc(arg1);1897 chsign(arg1);1898 sputc(arg1,savk);1899 pushp(arg1);1900 if(eqk() != 0)1901 return(1);1902 binop('+');1903 return(0);1904 }1906 int1907 command(void)1908 {1909 char line[100], *sl;1910 int pid, p, c;1912 switch(c = readc()) {1913 case '<':1914 return(cond(NL));1915 case '>':1916 return(cond(NG));1917 case '=':1918 return(cond(NE));1919 default:1920 sl = line;1921 *sl++ = c;1922 while((c = readc()) != '\n')1923 *sl++ = c;1924 *sl = 0;1925 if((pid = fork()) == 0) {1926 execl("/bin/rc","rc","-c",line,0);1927 exits("shell");1928 }1929 for(;;) {1930 if((p = waitpid()) < 0)1931 break;1932 if(p== pid)1933 break;1934 }1935 Bprint(&bout,"!\n");1936 return(0);1937 }1938 }1940 int1941 cond(char c)1942 {1943 Blk *p;1944 int cc;1946 if(subt() != 0)1947 return(1);1948 p = pop();1949 sclobber(p);1950 if(length(p) == 0) {1951 release(p);1952 if(c == '<' || c == '>' || c == NE) {1953 getstk();1954 return(0);1955 }1956 load();1957 return(1);1958 }1959 if(c == '='){1960 release(p);1961 getstk();1962 return(0);1963 }1964 if(c == NE) {1965 release(p);1966 load();1967 return(1);1968 }1969 fsfile(p);1970 cc = sbackc(p);1971 release(p);1972 if((cc<0 && (c == '<' || c == NG)) ||1973 (cc >0) && (c == '>' || c == NL)) {1974 getstk();1975 return(0);1976 }1977 load();1978 return(1);1979 }1981 void1982 load(void)1983 {1984 int c;1985 Blk *p, *q, *t, *s;1987 c = getstk() & 0377;1988 sptr = stable[c];1989 if(sptr != 0) {1990 p = sptr->val;1991 if(c >= ARRAYST) {1992 q = salloc(length(p));1993 rewind(p);1994 while(sfeof(p) == 0) {1995 s = dcgetwd(p);1996 if(s == 0) {1997 putwd(q, (Blk*)0);1998 } else {1999 t = copy(s,length(s));2000 putwd(q,t);2001 }2002 }2003 pushp(q);2004 } else {2005 q = copy(p,length(p));2006 pushp(q);2007 }2008 } else {2009 q = salloc(1);2010 if(c <= LASTFUN) {2011 Bprint(&bout,"function %c undefined\n",c+'a'-1);2012 sputc(q,'c');2013 sputc(q,'0');2014 sputc(q,' ');2015 sputc(q,'1');2016 sputc(q,'Q');2017 }2018 else2019 sputc(q,0);2020 pushp(q);2021 }2022 }2024 int2025 log2(long n)2026 {2027 int i;2029 if(n == 0)2030 return(0);2031 i=31;2032 if(n<0)2033 return(i);2034 while((n= n<<1) >0)2035 i--;2036 return i-1;2037 }2039 Blk*2040 salloc(int size)2041 {2042 Blk *hdr;2043 char *ptr;2045 all++;2046 lall++;2047 if(all - rel > active)2048 active = all - rel;2049 nbytes += size;2050 lbytes += size;2051 if(nbytes >maxsize)2052 maxsize = nbytes;2053 if(size > longest)2054 longest = size;2055 ptr = malloc((unsigned)size);2056 if(ptr == 0){2057 garbage("salloc");2058 if((ptr = malloc((unsigned)size)) == 0)2059 ospace("salloc");2060 }2061 if((hdr = hfree) == 0)2062 hdr = morehd();2063 hfree = (Blk *)hdr->rd;2064 hdr->rd = hdr->wt = hdr->beg = ptr;2065 hdr->last = ptr+size;2066 return(hdr);2067 }2069 Blk*2070 morehd(void)2071 {2072 Blk *h, *kk;2074 headmor++;2075 nbytes += HEADSZ;2076 hfree = h = (Blk *)malloc(HEADSZ);2077 if(hfree == 0) {2078 garbage("morehd");2079 if((hfree = h = (Blk*)malloc(HEADSZ)) == 0)2080 ospace("headers");2081 }2082 kk = h;2083 while(h<hfree+(HEADSZ/BLK))2084 (h++)->rd = (char*)++kk;2085 (h-1)->rd=0;2086 return(hfree);2087 }2089 Blk*2090 copy(Blk *hptr, int size)2091 {2092 Blk *hdr;2093 unsigned sz;2094 char *ptr;2096 all++;2097 lall++;2098 lcopy++;2099 nbytes += size;2100 lbytes += size;2101 if(size > longest)2102 longest = size;2103 if(size > maxsize)2104 maxsize = size;2105 sz = length(hptr);2106 ptr = nalloc(hptr->beg, size);2107 if(ptr == 0) {2108 garbage("copy");2109 if((ptr = nalloc(hptr->beg, size)) == 0) {2110 Bprint(&bout,"copy size %d\n",size);2111 ospace("copy");2112 }2113 }2114 if((hdr = hfree) == 0)2115 hdr = morehd();2116 hfree = (Blk *)hdr->rd;2117 hdr->rd = hdr->beg = ptr;2118 hdr->last = ptr+size;2119 hdr->wt = ptr+sz;2120 ptr = hdr->wt;2121 while(ptr<hdr->last)2122 *ptr++ = '\0';2123 return(hdr);2124 }2126 void2127 sdump(char *s1, Blk *hptr)2128 {2129 char *p;2131 Bprint(&bout,"%s %lx rd %lx wt %lx beg %lx last %lx\n",2132 s1,hptr,hptr->rd,hptr->wt,hptr->beg,hptr->last);2133 p = hptr->beg;2134 while(p < hptr->wt)2135 Bprint(&bout,"%d ",*p++);2136 Bprint(&bout,"\n");2137 }2139 void2140 seekc(Blk *hptr, int n)2141 {2142 char *nn,*p;2144 nn = hptr->beg+n;2145 if(nn > hptr->last) {2146 nbytes += nn - hptr->last;2147 if(nbytes > maxsize)2148 maxsize = nbytes;2149 lbytes += nn - hptr->last;2150 if(n > longest)2151 longest = n;2152 /* free(hptr->beg); */2153 p = realloc(hptr->beg, n);2154 if(p == 0) {2155 /* hptr->beg = realloc(hptr->beg, hptr->last-hptr->beg);2156 ** garbage("seekc");2157 ** if((p = realloc(hptr->beg, n)) == 0)2158 */ ospace("seekc");2159 }2160 hptr->beg = p;2161 hptr->wt = hptr->last = hptr->rd = p+n;2162 return;2163 }2164 hptr->rd = nn;2165 if(nn>hptr->wt)2166 hptr->wt = nn;2167 }2169 void2170 salterwd(Blk *ahptr, Blk *n)2171 {2172 Wblk *hptr;2174 hptr = (Wblk*)ahptr;2175 if(hptr->rdw == hptr->lastw)2176 more(ahptr);2177 *hptr->rdw++ = n;2178 if(hptr->rdw > hptr->wtw)2179 hptr->wtw = hptr->rdw;2180 }2182 void2183 more(Blk *hptr)2184 {2185 unsigned size;2186 char *p;2188 if((size=(hptr->last-hptr->beg)*2) == 0)2189 size=2;2190 nbytes += size/2;2191 if(nbytes > maxsize)2192 maxsize = nbytes;2193 if(size > longest)2194 longest = size;2195 lbytes += size/2;2196 lmore++;2197 /* free(hptr->beg);*/2198 p = realloc(hptr->beg, size);2200 if(p == 0) {2201 /* hptr->beg = realloc(hptr->beg, (hptr->last-hptr->beg));2202 ** garbage("more");2203 ** if((p = realloc(hptr->beg,size)) == 0)2204 */ ospace("more");2205 }2206 hptr->rd = p + (hptr->rd - hptr->beg);2207 hptr->wt = p + (hptr->wt - hptr->beg);2208 hptr->beg = p;2209 hptr->last = p+size;2210 }2212 void2213 ospace(char *s)2214 {2215 Bprint(&bout,"out of space: %s\n",s);2216 Bprint(&bout,"all %ld rel %ld headmor %ld\n",all,rel,headmor);2217 Bprint(&bout,"nbytes %ld\n",nbytes);2218 sdump("stk",*stkptr);2219 abort();2220 }2222 void2223 garbage(char *s)2224 {2225 USED(s);2226 }2228 void2229 release(Blk *p)2230 {2231 rel++;2232 lrel++;2233 nbytes -= p->last - p->beg;2234 p->rd = (char*)hfree;2235 hfree = p;2236 free(p->beg);2237 }2239 Blk*2240 dcgetwd(Blk *p)2241 {2242 Wblk *wp;2244 wp = (Wblk*)p;2245 if(wp->rdw == wp->wtw)2246 return(0);2247 return(*wp->rdw++);2248 }2250 void2251 putwd(Blk *p, Blk *c)2252 {2253 Wblk *wp;2255 wp = (Wblk*)p;2256 if(wp->wtw == wp->lastw)2257 more(p);2258 *wp->wtw++ = c;2259 }2261 Blk*2262 lookwd(Blk *p)2263 {2264 Wblk *wp;2266 wp = (Wblk*)p;2267 if(wp->rdw == wp->wtw)2268 return(0);2269 return(*wp->rdw);2270 }2272 char*2273 nalloc(char *p, unsigned nbytes)2274 {2275 char *q, *r;2277 q = r = malloc(nbytes);2278 if(q==0)2279 return(0);2280 while(nbytes--)2281 *q++ = *p++;2282 return(r);2283 }2285 int2286 getstk(void)2287 {2288 int n;2289 uchar c;2291 c = readc();2292 if(c != '<')2293 return c;2294 n = 0;2295 while(1) {2296 c = readc();2297 if(c == '>')2298 break;2299 n = n*10+c-'0';2300 }2301 return n;2302 }