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