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