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