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