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