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