2.9BSD - /usr/src/cmd/dc/dc.c

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

Defined functions