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