4.3BSD - /usr/src/usr.bin/dc/dc.c

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

Defined functions

Defined variables