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