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

Defined functions

add defined in line 1420; used 9 times
add0 defined in line 1001; used 7 times
bigot defined in line 1369; used 2 times
binop defined in line 1148; used 5 times
chsign defined in line 1082; used 15 times
command defined in line 1556; used 2 times
commnds defined in line 16; used 2 times
cond defined in line 1585; used 4 times
copy defined in line 1719; used 21 times
div defined in line 581; used 11 times
dscale defined in line 702; used 2 times
eqk defined in line 1467; used 2 times
exp defined in line 811; used 3 times
garbage defined in line 1820; used 5 times
getdec defined in line 1250; used 3 times
getwd defined in line 1895; used 6 times
hexot defined in line 1350; used 2 times
init defined in line 866; used 1 times
  • in line 13
load defined in line 1626; used 4 times
log2 defined in line 1659; used 2 times
lookwd defined in line 1918; used 2 times
main defined in line 9; never used
more defined in line 1790; used 4 times
morehd defined in line 1694; used 3 times
mult defined in line 1026; used 8 times
nalloc defined in line 1929; used 3 times
oneot defined in line 1331; used 2 times
onintr defined in line 924; used 3 times
ospace defined in line 1811; used 7 times
pop defined in line 945; used 29 times
print defined in line 1170; used 2 times
pushp defined in line 934; used 32 times
putwd defined in line 1907; used 3 times
readc defined in line 1116; used 19 times
readin defined in line 953; used 3 times
redef defined in line 1866; used 2 times
release defined in line 1885; used 93 times
removc defined in line 1496; used 7 times
removr defined in line 731; used 2 times
salloc defined in line 1671; used 34 times
salterwd defined in line 1781; used 1 times
scale defined in line 1527; used 2 times
scalint defined in line 1518; used 6 times
sdump defined in line 1748; used 4 times
seekc defined in line 1758; used 5 times
sqrt defined in line 760; used 2 times
subt defined in line 1545; used 2 times
tenot defined in line 1282; used 1 times
unreadc defined in line 1138; used 4 times

Defined variables

sccsid defined in line 2; never used
Last modified: 2000-02-13
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 11929
Valid CSS Valid XHTML 1.0 Strict