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