sys/src/cmd/dc.c

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