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