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(&bout,"\\\n"); count=ll;} }
46 #define TEST2		{if((count -= 2) <=0){Bprint(&bout,"\\\n");count=ll;}}
47 #define EMPTY		if(stkerr != 0){Bprint(&bout,"stack empty\n"); continue; }
48 #define EMPTYR(x)	if(stkerr!=0){pushp(x);Bprint(&bout,"stack empty\n");continue;}
49 #define EMPTYS		if(stkerr != 0){Bprint(&bout,"stack empty\n"); return(1);}
50 #define EMPTYSR(x)	if(stkerr !=0){Bprint(&bout,"stack empty\n");pushp(x);return(1);}
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",all,rel,headmor);
221 			Bprint(&bout, "nbytes %ld\n",nbytes);
222 			Bprint(&bout, "longest %ld active %ld maxsize %ld\n", longest,
223 				active, maxsize);
224 			Bprint(&bout, "new all %d rel %d copy %d more %d lbytes %d\n",
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 -exp bug*/
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 elt prints as 0*/
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 corrupt ddivr*/
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 undershot*/
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->beg);
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 }