GopherProxy

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