|  | #include <u.h> | 
|  | #include <libc.h> | 
|  | #include <bio.h> | 
|  |  | 
|  | typedef	void*	pointer; | 
|  |  | 
|  | #define div	dcdiv | 
|  |  | 
|  | #define FATAL 0 | 
|  | #define NFATAL 1 | 
|  | #define BLK sizeof(Blk) | 
|  | #define PTRSZ sizeof(int*) | 
|  | #define HEADSZ 1024 | 
|  | #define STKSZ 100 | 
|  | #define RDSKSZ 100 | 
|  | #define TBLSZ 256 | 
|  | #define ARRAYST 221 | 
|  | #define MAXIND 2048 | 
|  | #define NL 1 | 
|  | #define NG 2 | 
|  | #define NE 3 | 
|  | #define length(p)	((p)->wt-(p)->beg) | 
|  | #define rewind(p)	(p)->rd=(p)->beg | 
|  | #undef create | 
|  | #define create(p)	(p)->rd = (p)->wt = (p)->beg | 
|  | #define fsfile(p)	(p)->rd = (p)->wt | 
|  | #define truncate(p)	(p)->wt = (p)->rd | 
|  | #define sfeof(p)	(((p)->rd==(p)->wt)?1:0) | 
|  | #define sfbeg(p)	(((p)->rd==(p)->beg)?1:0) | 
|  | #define sungetc(p,c)	*(--(p)->rd)=c | 
|  | #define sgetc(p)	(((p)->rd==(p)->wt)?-1:*(p)->rd++) | 
|  | #define skipc(p)	{if((p)->rd<(p)->wt)(p)->rd++;} | 
|  | #define slookc(p)	(((p)->rd==(p)->wt)?-1:*(p)->rd) | 
|  | #define sbackc(p)	(((p)->rd==(p)->beg)?-1:*(--(p)->rd)) | 
|  | #define backc(p)	{if((p)->rd>(p)->beg) --(p)->rd;} | 
|  | #define sputc(p,c)	{if((p)->wt==(p)->last)more(p);\ | 
|  | *(p)->wt++ = c; } | 
|  | #define salterc(p,c)	{if((p)->rd==(p)->last)more(p);\ | 
|  | *(p)->rd++ = c;\ | 
|  | if((p)->rd>(p)->wt)(p)->wt=(p)->rd;} | 
|  | #define sunputc(p)	(*((p)->rd = --(p)->wt)) | 
|  | #define sclobber(p)	((p)->rd = --(p)->wt) | 
|  | #define zero(p)		for(pp=(p)->beg;pp<(p)->last;)\ | 
|  | *pp++='\0' | 
|  | #define OUTC(x)		{Bputc(&bout,x); if(--count == 0){Bprint(&bout,"\\\n"); count=ll;} } | 
|  | #define TEST2		{if((count -= 2) <=0){Bprint(&bout,"\\\n");count=ll;}} | 
|  | #define EMPTY		if(stkerr != 0){Bprint(&bout,"stack empty\n"); continue; } | 
|  | #define EMPTYR(x)	if(stkerr!=0){pushp(x);Bprint(&bout,"stack empty\n");continue;} | 
|  | #define EMPTYS		if(stkerr != 0){Bprint(&bout,"stack empty\n"); return(1);} | 
|  | #define EMPTYSR(x)	if(stkerr !=0){Bprint(&bout,"stack empty\n");pushp(x);return(1);} | 
|  | #define error(p)	{Bprint(&bout,p); continue; } | 
|  | #define errorrt(p)	{Bprint(&bout,p); return(1); } | 
|  | #define LASTFUN 026 | 
|  |  | 
|  | typedef	struct	Blk	Blk; | 
|  | struct	Blk | 
|  | { | 
|  | char	*rd; | 
|  | char	*wt; | 
|  | char	*beg; | 
|  | char	*last; | 
|  | }; | 
|  | typedef	struct	Sym	Sym; | 
|  | struct	Sym | 
|  | { | 
|  | Sym	*next; | 
|  | Blk	*val; | 
|  | }; | 
|  | typedef	struct	Wblk	Wblk; | 
|  | struct	Wblk | 
|  | { | 
|  | Blk	**rdw; | 
|  | Blk	**wtw; | 
|  | Blk	**begw; | 
|  | Blk	**lastw; | 
|  | }; | 
|  |  | 
|  | Biobuf	*curfile, *fsave; | 
|  | Blk	*arg1, *arg2; | 
|  | uchar	savk; | 
|  | int	dbg; | 
|  | int	ifile; | 
|  | Blk	*scalptr, *basptr, *tenptr, *inbas; | 
|  | Blk	*sqtemp, *chptr, *strptr, *divxyz; | 
|  | Blk	*stack[STKSZ]; | 
|  | Blk	**stkptr,**stkbeg; | 
|  | Blk	**stkend; | 
|  | Blk	*hfree; | 
|  | int	stkerr; | 
|  | int	lastchar; | 
|  | Blk	*readstk[RDSKSZ]; | 
|  | Blk	**readptr; | 
|  | Blk	*rem; | 
|  | int	k; | 
|  | Blk	*irem; | 
|  | int	skd,skr; | 
|  | int	neg; | 
|  | Sym	symlst[TBLSZ]; | 
|  | Sym	*stable[TBLSZ]; | 
|  | Sym	*sptr, *sfree; | 
|  | long	rel; | 
|  | long	nbytes; | 
|  | long	all; | 
|  | long	headmor; | 
|  | long	obase; | 
|  | int	fw,fw1,ll; | 
|  | void	(*outdit)(Blk *p, int flg); | 
|  | int	logo; | 
|  | int	logten; | 
|  | int	count; | 
|  | char	*pp; | 
|  | char	*dummy; | 
|  | long	longest, maxsize, active; | 
|  | int	lall, lrel, lcopy, lmore, lbytes; | 
|  | int	inside; | 
|  | Biobuf	bin; | 
|  | Biobuf	bout; | 
|  |  | 
|  | void	main(int argc, char *argv[]); | 
|  | void	commnds(void); | 
|  | Blk*	readin(void); | 
|  | Blk*	div(Blk *ddivd, Blk *ddivr); | 
|  | int	dscale(void); | 
|  | Blk*	removr(Blk *p, int n); | 
|  | Blk*	dcsqrt(Blk *p); | 
|  | void	init(int argc, char *argv[]); | 
|  | void	onintr(void); | 
|  | void	pushp(Blk *p); | 
|  | Blk*	pop(void); | 
|  | Blk*	readin(void); | 
|  | Blk*	add0(Blk *p, int ct); | 
|  | Blk*	mult(Blk *p, Blk *q); | 
|  | void	chsign(Blk *p); | 
|  | int	readc(void); | 
|  | void	unreadc(char c); | 
|  | void	binop(char c); | 
|  | void	dcprint(Blk *hptr); | 
|  | Blk*	dcexp(Blk *base, Blk *ex); | 
|  | Blk*	getdec(Blk *p, int sc); | 
|  | void	tenot(Blk *p, int sc); | 
|  | void	oneot(Blk *p, int sc, char ch); | 
|  | void	hexot(Blk *p, int flg); | 
|  | void	bigot(Blk *p, int flg); | 
|  | Blk*	add(Blk *a1, Blk *a2); | 
|  | int	eqk(void); | 
|  | Blk*	removc(Blk *p, int n); | 
|  | Blk*	scalint(Blk *p); | 
|  | Blk*	scale(Blk *p, int n); | 
|  | int	subt(void); | 
|  | int	command(void); | 
|  | int	cond(char c); | 
|  | void	load(void); | 
|  | #define log2 dclog2 | 
|  | int	log2(long n); | 
|  | Blk*	salloc(int size); | 
|  | Blk*	morehd(void); | 
|  | Blk*	copy(Blk *hptr, int size); | 
|  | void	sdump(char *s1, Blk *hptr); | 
|  | void	seekc(Blk *hptr, int n); | 
|  | void	salterwd(Blk *hptr, Blk *n); | 
|  | void	more(Blk *hptr); | 
|  | void	ospace(char *s); | 
|  | void	garbage(char *s); | 
|  | void	release(Blk *p); | 
|  | Blk*	dcgetwd(Blk *p); | 
|  | void	putwd(Blk *p, Blk *c); | 
|  | Blk*	lookwd(Blk *p); | 
|  | char*	nalloc(char *p, unsigned nbytes); | 
|  | int	getstk(void); | 
|  |  | 
|  | /********debug only**/ | 
|  | void | 
|  | tpr(char *cp, Blk *bp) | 
|  | { | 
|  | print("%s-> ", cp); | 
|  | print("beg: %lx rd: %lx wt: %lx last: %lx\n", bp->beg, bp->rd, | 
|  | bp->wt, bp->last); | 
|  | for (cp = bp->beg; cp != bp->wt; cp++) { | 
|  | print("%d", *cp); | 
|  | if (cp != bp->wt-1) | 
|  | print("/"); | 
|  | } | 
|  | print("\n"); | 
|  | } | 
|  | /************/ | 
|  |  | 
|  | void | 
|  | main(int argc, char *argv[]) | 
|  | { | 
|  | Binit(&bin, 0, OREAD); | 
|  | Binit(&bout, 1, OWRITE); | 
|  | init(argc,argv); | 
|  | commnds(); | 
|  | exits(0); | 
|  | } | 
|  |  | 
|  | void | 
|  | commnds(void) | 
|  | { | 
|  | Blk *p, *q, **ptr, *s, *t; | 
|  | long l; | 
|  | Sym *sp; | 
|  | int sk, sk1, sk2, c, sign, n, d; | 
|  |  | 
|  | while(1) { | 
|  | Bflush(&bout); | 
|  | if(((c = readc())>='0' && c <= '9') || | 
|  | (c>='A' && c <='F') || c == '.') { | 
|  | unreadc(c); | 
|  | p = readin(); | 
|  | pushp(p); | 
|  | continue; | 
|  | } | 
|  | switch(c) { | 
|  | case ' ': | 
|  | case '\n': | 
|  | case -1: | 
|  | continue; | 
|  | case 'Y': | 
|  | sdump("stk",*stkptr); | 
|  | Bprint(&bout, "all %ld rel %ld headmor %ld\n",all,rel,headmor); | 
|  | Bprint(&bout, "nbytes %ld\n",nbytes); | 
|  | Bprint(&bout, "longest %ld active %ld maxsize %ld\n", longest, | 
|  | active, maxsize); | 
|  | Bprint(&bout, "new all %d rel %d copy %d more %d lbytes %d\n", | 
|  | lall, lrel, lcopy, lmore, lbytes); | 
|  | lall = lrel = lcopy = lmore = lbytes = 0; | 
|  | continue; | 
|  | case '_': | 
|  | p = readin(); | 
|  | savk = sunputc(p); | 
|  | chsign(p); | 
|  | sputc(p,savk); | 
|  | pushp(p); | 
|  | continue; | 
|  | case '-': | 
|  | subt(); | 
|  | continue; | 
|  | case '+': | 
|  | if(eqk() != 0) | 
|  | continue; | 
|  | binop('+'); | 
|  | continue; | 
|  | case '*': | 
|  | arg1 = pop(); | 
|  | EMPTY; | 
|  | arg2 = pop(); | 
|  | EMPTYR(arg1); | 
|  | sk1 = sunputc(arg1); | 
|  | sk2 = sunputc(arg2); | 
|  | savk = sk1+sk2; | 
|  | binop('*'); | 
|  | p = pop(); | 
|  | if(savk>k && savk>sk1 && savk>sk2) { | 
|  | sclobber(p); | 
|  | sk = sk1; | 
|  | if(sk<sk2) | 
|  | sk = sk2; | 
|  | if(sk<k) | 
|  | sk = k; | 
|  | p = removc(p,savk-sk); | 
|  | savk = sk; | 
|  | sputc(p,savk); | 
|  | } | 
|  | pushp(p); | 
|  | continue; | 
|  | case '/': | 
|  | casediv: | 
|  | if(dscale() != 0) | 
|  | continue; | 
|  | binop('/'); | 
|  | if(irem != 0) | 
|  | release(irem); | 
|  | release(rem); | 
|  | continue; | 
|  | case '%': | 
|  | if(dscale() != 0) | 
|  | continue; | 
|  | binop('/'); | 
|  | p = pop(); | 
|  | release(p); | 
|  | if(irem == 0) { | 
|  | sputc(rem,skr+k); | 
|  | pushp(rem); | 
|  | continue; | 
|  | } | 
|  | p = add0(rem,skd-(skr+k)); | 
|  | q = add(p,irem); | 
|  | release(p); | 
|  | release(irem); | 
|  | sputc(q,skd); | 
|  | pushp(q); | 
|  | continue; | 
|  | case 'v': | 
|  | p = pop(); | 
|  | EMPTY; | 
|  | savk = sunputc(p); | 
|  | if(length(p) == 0) { | 
|  | sputc(p,savk); | 
|  | pushp(p); | 
|  | continue; | 
|  | } | 
|  | if(sbackc(p)<0) { | 
|  | error("sqrt of neg number\n"); | 
|  | } | 
|  | if(k<savk) | 
|  | n = savk; | 
|  | else { | 
|  | n = k*2-savk; | 
|  | savk = k; | 
|  | } | 
|  | arg1 = add0(p,n); | 
|  | arg2 = dcsqrt(arg1); | 
|  | sputc(arg2,savk); | 
|  | pushp(arg2); | 
|  | continue; | 
|  |  | 
|  | case '^': | 
|  | neg = 0; | 
|  | arg1 = pop(); | 
|  | EMPTY; | 
|  | if(sunputc(arg1) != 0) | 
|  | error("exp not an integer\n"); | 
|  | arg2 = pop(); | 
|  | EMPTYR(arg1); | 
|  | if(sfbeg(arg1) == 0 && sbackc(arg1)<0) { | 
|  | neg++; | 
|  | chsign(arg1); | 
|  | } | 
|  | if(length(arg1)>=3) { | 
|  | error("exp too big\n"); | 
|  | } | 
|  | savk = sunputc(arg2); | 
|  | p = dcexp(arg2,arg1); | 
|  | release(arg2); | 
|  | rewind(arg1); | 
|  | c = sgetc(arg1); | 
|  | if(c == -1) | 
|  | c = 0; | 
|  | else | 
|  | if(sfeof(arg1) == 0) | 
|  | c = sgetc(arg1)*100 + c; | 
|  | d = c*savk; | 
|  | release(arg1); | 
|  | /*	if(neg == 0) {		removed to fix -exp bug*/ | 
|  | if(k>=savk) | 
|  | n = k; | 
|  | else | 
|  | n = savk; | 
|  | if(n<d) { | 
|  | q = removc(p,d-n); | 
|  | sputc(q,n); | 
|  | pushp(q); | 
|  | } else { | 
|  | sputc(p,d); | 
|  | pushp(p); | 
|  | } | 
|  | /*	} else { this is disaster for exp <-127 */ | 
|  | /*		sputc(p,d);		*/ | 
|  | /*		pushp(p);		*/ | 
|  | /*	}				*/ | 
|  | if(neg == 0) | 
|  | continue; | 
|  | p = pop(); | 
|  | q = salloc(2); | 
|  | sputc(q,1); | 
|  | sputc(q,0); | 
|  | pushp(q); | 
|  | pushp(p); | 
|  | goto casediv; | 
|  | case 'z': | 
|  | p = salloc(2); | 
|  | n = stkptr - stkbeg; | 
|  | if(n >= 100) { | 
|  | sputc(p,n/100); | 
|  | n %= 100; | 
|  | } | 
|  | sputc(p,n); | 
|  | sputc(p,0); | 
|  | pushp(p); | 
|  | continue; | 
|  | case 'Z': | 
|  | p = pop(); | 
|  | EMPTY; | 
|  | n = (length(p)-1)<<1; | 
|  | fsfile(p); | 
|  | backc(p); | 
|  | if(sfbeg(p) == 0) { | 
|  | if((c = sbackc(p))<0) { | 
|  | n -= 2; | 
|  | if(sfbeg(p) == 1) | 
|  | n++; | 
|  | else { | 
|  | if((c = sbackc(p)) == 0) | 
|  | n++; | 
|  | else | 
|  | if(c > 90) | 
|  | n--; | 
|  | } | 
|  | } else | 
|  | if(c < 10) | 
|  | n--; | 
|  | } | 
|  | release(p); | 
|  | q = salloc(1); | 
|  | if(n >= 100) { | 
|  | sputc(q,n%100); | 
|  | n /= 100; | 
|  | } | 
|  | sputc(q,n); | 
|  | sputc(q,0); | 
|  | pushp(q); | 
|  | continue; | 
|  | case 'i': | 
|  | p = pop(); | 
|  | EMPTY; | 
|  | p = scalint(p); | 
|  | release(inbas); | 
|  | inbas = p; | 
|  | continue; | 
|  | case 'I': | 
|  | p = copy(inbas,length(inbas)+1); | 
|  | sputc(p,0); | 
|  | pushp(p); | 
|  | continue; | 
|  | case 'o': | 
|  | p = pop(); | 
|  | EMPTY; | 
|  | p = scalint(p); | 
|  | sign = 0; | 
|  | n = length(p); | 
|  | q = copy(p,n); | 
|  | fsfile(q); | 
|  | l = c = sbackc(q); | 
|  | if(n != 1) { | 
|  | if(c<0) { | 
|  | sign = 1; | 
|  | chsign(q); | 
|  | n = length(q); | 
|  | fsfile(q); | 
|  | l = c = sbackc(q); | 
|  | } | 
|  | if(n != 1) { | 
|  | while(sfbeg(q) == 0) | 
|  | l = l*100+sbackc(q); | 
|  | } | 
|  | } | 
|  | logo = log2(l); | 
|  | obase = l; | 
|  | release(basptr); | 
|  | if(sign == 1) | 
|  | obase = -l; | 
|  | basptr = p; | 
|  | outdit = bigot; | 
|  | if(n == 1 && sign == 0) { | 
|  | if(c <= 16) { | 
|  | outdit = hexot; | 
|  | fw = 1; | 
|  | fw1 = 0; | 
|  | ll = 70; | 
|  | release(q); | 
|  | continue; | 
|  | } | 
|  | } | 
|  | n = 0; | 
|  | if(sign == 1) | 
|  | n++; | 
|  | p = salloc(1); | 
|  | sputc(p,-1); | 
|  | t = add(p,q); | 
|  | n += length(t)*2; | 
|  | fsfile(t); | 
|  | if(sbackc(t)>9) | 
|  | n++; | 
|  | release(t); | 
|  | release(q); | 
|  | release(p); | 
|  | fw = n; | 
|  | fw1 = n-1; | 
|  | ll = 70; | 
|  | if(fw>=ll) | 
|  | continue; | 
|  | ll = (70/fw)*fw; | 
|  | continue; | 
|  | case 'O': | 
|  | p = copy(basptr,length(basptr)+1); | 
|  | sputc(p,0); | 
|  | pushp(p); | 
|  | continue; | 
|  | case '[': | 
|  | n = 0; | 
|  | p = salloc(0); | 
|  | for(;;) { | 
|  | if((c = readc()) == ']') { | 
|  | if(n == 0) | 
|  | break; | 
|  | n--; | 
|  | } | 
|  | sputc(p,c); | 
|  | if(c == '[') | 
|  | n++; | 
|  | } | 
|  | pushp(p); | 
|  | continue; | 
|  | case 'k': | 
|  | p = pop(); | 
|  | EMPTY; | 
|  | p = scalint(p); | 
|  | if(length(p)>1) { | 
|  | error("scale too big\n"); | 
|  | } | 
|  | rewind(p); | 
|  | k = 0; | 
|  | if(!sfeof(p)) | 
|  | k = sgetc(p); | 
|  | release(scalptr); | 
|  | scalptr = p; | 
|  | continue; | 
|  | case 'K': | 
|  | p = copy(scalptr,length(scalptr)+1); | 
|  | sputc(p,0); | 
|  | pushp(p); | 
|  | continue; | 
|  | case 'X': | 
|  | p = pop(); | 
|  | EMPTY; | 
|  | fsfile(p); | 
|  | n = sbackc(p); | 
|  | release(p); | 
|  | p = salloc(2); | 
|  | sputc(p,n); | 
|  | sputc(p,0); | 
|  | pushp(p); | 
|  | continue; | 
|  | case 'Q': | 
|  | p = pop(); | 
|  | EMPTY; | 
|  | if(length(p)>2) { | 
|  | error("Q?\n"); | 
|  | } | 
|  | rewind(p); | 
|  | if((c =  sgetc(p))<0) { | 
|  | error("neg Q\n"); | 
|  | } | 
|  | release(p); | 
|  | while(c-- > 0) { | 
|  | if(readptr == &readstk[0]) { | 
|  | error("readstk?\n"); | 
|  | } | 
|  | if(*readptr != 0) | 
|  | release(*readptr); | 
|  | readptr--; | 
|  | } | 
|  | continue; | 
|  | case 'q': | 
|  | if(readptr <= &readstk[1]) | 
|  | exits(0); | 
|  | if(*readptr != 0) | 
|  | release(*readptr); | 
|  | readptr--; | 
|  | if(*readptr != 0) | 
|  | release(*readptr); | 
|  | readptr--; | 
|  | continue; | 
|  | case 'f': | 
|  | if(stkptr == &stack[0]) | 
|  | Bprint(&bout,"empty stack\n"); | 
|  | else { | 
|  | for(ptr = stkptr; ptr > &stack[0];) { | 
|  | dcprint(*ptr--); | 
|  | } | 
|  | } | 
|  | continue; | 
|  | case 'p': | 
|  | if(stkptr == &stack[0]) | 
|  | Bprint(&bout,"empty stack\n"); | 
|  | else { | 
|  | dcprint(*stkptr); | 
|  | } | 
|  | continue; | 
|  | case 'P': | 
|  | p = pop(); | 
|  | EMPTY; | 
|  | sputc(p,0); | 
|  | Bprint(&bout,"%s",p->beg); | 
|  | release(p); | 
|  | continue; | 
|  | case 'd': | 
|  | if(stkptr == &stack[0]) { | 
|  | Bprint(&bout,"empty stack\n"); | 
|  | continue; | 
|  | } | 
|  | q = *stkptr; | 
|  | n = length(q); | 
|  | p = copy(*stkptr,n); | 
|  | pushp(p); | 
|  | continue; | 
|  | case 'c': | 
|  | while(stkerr == 0) { | 
|  | p = pop(); | 
|  | if(stkerr == 0) | 
|  | release(p); | 
|  | } | 
|  | continue; | 
|  | case 'S': | 
|  | if(stkptr == &stack[0]) { | 
|  | error("save: args\n"); | 
|  | } | 
|  | c = getstk() & 0377; | 
|  | sptr = stable[c]; | 
|  | sp = stable[c] = sfree; | 
|  | sfree = sfree->next; | 
|  | if(sfree == 0) | 
|  | goto sempty; | 
|  | sp->next = sptr; | 
|  | p = pop(); | 
|  | EMPTY; | 
|  | if(c >= ARRAYST) { | 
|  | q = copy(p,length(p)+PTRSZ); | 
|  | for(n = 0;n < PTRSZ;n++) { | 
|  | sputc(q,0); | 
|  | } | 
|  | release(p); | 
|  | p = q; | 
|  | } | 
|  | sp->val = p; | 
|  | continue; | 
|  | sempty: | 
|  | error("symbol table overflow\n"); | 
|  | case 's': | 
|  | if(stkptr == &stack[0]) { | 
|  | error("save:args\n"); | 
|  | } | 
|  | c = getstk() & 0377; | 
|  | sptr = stable[c]; | 
|  | if(sptr != 0) { | 
|  | p = sptr->val; | 
|  | if(c >= ARRAYST) { | 
|  | rewind(p); | 
|  | while(sfeof(p) == 0) | 
|  | release(dcgetwd(p)); | 
|  | } | 
|  | release(p); | 
|  | } else { | 
|  | sptr = stable[c] = sfree; | 
|  | sfree = sfree->next; | 
|  | if(sfree == 0) | 
|  | goto sempty; | 
|  | sptr->next = 0; | 
|  | } | 
|  | p = pop(); | 
|  | sptr->val = p; | 
|  | continue; | 
|  | case 'l': | 
|  | load(); | 
|  | continue; | 
|  | case 'L': | 
|  | c = getstk() & 0377; | 
|  | sptr = stable[c]; | 
|  | if(sptr == 0) { | 
|  | error("L?\n"); | 
|  | } | 
|  | stable[c] = sptr->next; | 
|  | sptr->next = sfree; | 
|  | sfree = sptr; | 
|  | p = sptr->val; | 
|  | if(c >= ARRAYST) { | 
|  | rewind(p); | 
|  | while(sfeof(p) == 0) { | 
|  | q = dcgetwd(p); | 
|  | if(q != 0) | 
|  | release(q); | 
|  | } | 
|  | } | 
|  | pushp(p); | 
|  | continue; | 
|  | case ':': | 
|  | p = pop(); | 
|  | EMPTY; | 
|  | q = scalint(p); | 
|  | fsfile(q); | 
|  | c = 0; | 
|  | if((sfbeg(q) == 0) && ((c = sbackc(q))<0)) { | 
|  | error("neg index\n"); | 
|  | } | 
|  | if(length(q)>2) { | 
|  | error("index too big\n"); | 
|  | } | 
|  | if(sfbeg(q) == 0) | 
|  | c = c*100+sbackc(q); | 
|  | if(c >= MAXIND) { | 
|  | error("index too big\n"); | 
|  | } | 
|  | release(q); | 
|  | n = getstk() & 0377; | 
|  | sptr = stable[n]; | 
|  | if(sptr == 0) { | 
|  | sptr = stable[n] = sfree; | 
|  | sfree = sfree->next; | 
|  | if(sfree == 0) | 
|  | goto sempty; | 
|  | sptr->next = 0; | 
|  | p = salloc((c+PTRSZ)*PTRSZ); | 
|  | zero(p); | 
|  | } else { | 
|  | p = sptr->val; | 
|  | if(length(p)-PTRSZ < c*PTRSZ) { | 
|  | q = copy(p,(c+PTRSZ)*PTRSZ); | 
|  | release(p); | 
|  | p = q; | 
|  | } | 
|  | } | 
|  | seekc(p,c*PTRSZ); | 
|  | q = lookwd(p); | 
|  | if(q!=0) | 
|  | release(q); | 
|  | s = pop(); | 
|  | EMPTY; | 
|  | salterwd(p, s); | 
|  | sptr->val = p; | 
|  | continue; | 
|  | case ';': | 
|  | p = pop(); | 
|  | EMPTY; | 
|  | q = scalint(p); | 
|  | fsfile(q); | 
|  | c = 0; | 
|  | if((sfbeg(q) == 0) && ((c = sbackc(q))<0)) { | 
|  | error("neg index\n"); | 
|  | } | 
|  | if(length(q)>2) { | 
|  | error("index too big\n"); | 
|  | } | 
|  | if(sfbeg(q) == 0) | 
|  | c = c*100+sbackc(q); | 
|  | if(c >= MAXIND) { | 
|  | error("index too big\n"); | 
|  | } | 
|  | release(q); | 
|  | n = getstk() & 0377; | 
|  | sptr = stable[n]; | 
|  | if(sptr != 0){ | 
|  | p = sptr->val; | 
|  | if(length(p)-PTRSZ >= c*PTRSZ) { | 
|  | seekc(p,c*PTRSZ); | 
|  | s = dcgetwd(p); | 
|  | if(s != 0) { | 
|  | q = copy(s,length(s)); | 
|  | pushp(q); | 
|  | continue; | 
|  | } | 
|  | } | 
|  | } | 
|  | q = salloc(1);	/*so uninitialized array elt prints as 0*/ | 
|  | sputc(q, 0); | 
|  | pushp(q); | 
|  | continue; | 
|  | case 'x': | 
|  | execute: | 
|  | p = pop(); | 
|  | EMPTY; | 
|  | if((readptr != &readstk[0]) && (*readptr != 0)) { | 
|  | if((*readptr)->rd == (*readptr)->wt) | 
|  | release(*readptr); | 
|  | else { | 
|  | if(readptr++ == &readstk[RDSKSZ]) { | 
|  | error("nesting depth\n"); | 
|  | } | 
|  | } | 
|  | } else | 
|  | readptr++; | 
|  | *readptr = p; | 
|  | if(p != 0) | 
|  | rewind(p); | 
|  | else { | 
|  | if((c = readc()) != '\n') | 
|  | unreadc(c); | 
|  | } | 
|  | continue; | 
|  | case '?': | 
|  | if(++readptr == &readstk[RDSKSZ]) { | 
|  | error("nesting depth\n"); | 
|  | } | 
|  | *readptr = 0; | 
|  | fsave = curfile; | 
|  | curfile = &bin; | 
|  | while((c = readc()) == '!') | 
|  | command(); | 
|  | p = salloc(0); | 
|  | sputc(p,c); | 
|  | while((c = readc()) != '\n') { | 
|  | sputc(p,c); | 
|  | if(c == '\\') | 
|  | sputc(p,readc()); | 
|  | } | 
|  | curfile = fsave; | 
|  | *readptr = p; | 
|  | continue; | 
|  | case '!': | 
|  | if(command() == 1) | 
|  | goto execute; | 
|  | continue; | 
|  | case '<': | 
|  | case '>': | 
|  | case '=': | 
|  | if(cond(c) == 1) | 
|  | goto execute; | 
|  | continue; | 
|  | default: | 
|  | Bprint(&bout,"%o is unimplemented\n",c); | 
|  | } | 
|  | } | 
|  | } | 
|  |  | 
|  | Blk* | 
|  | div(Blk *ddivd, Blk *ddivr) | 
|  | { | 
|  | int divsign, remsign, offset, divcarry, | 
|  | carry, dig, magic, d, dd, under, first; | 
|  | long c, td, cc; | 
|  | Blk *ps, *px, *p, *divd, *divr; | 
|  |  | 
|  | dig = 0; | 
|  | under = 0; | 
|  | divcarry = 0; | 
|  | rem = 0; | 
|  | p = salloc(0); | 
|  | if(length(ddivr) == 0) { | 
|  | pushp(ddivr); | 
|  | Bprint(&bout,"divide by 0\n"); | 
|  | return(p); | 
|  | } | 
|  | divsign = remsign = first = 0; | 
|  | divr = ddivr; | 
|  | fsfile(divr); | 
|  | if(sbackc(divr) == -1) { | 
|  | divr = copy(ddivr,length(ddivr)); | 
|  | chsign(divr); | 
|  | divsign = ~divsign; | 
|  | } | 
|  | divd = copy(ddivd,length(ddivd)); | 
|  | fsfile(divd); | 
|  | if(sfbeg(divd) == 0 && sbackc(divd) == -1) { | 
|  | chsign(divd); | 
|  | divsign = ~divsign; | 
|  | remsign = ~remsign; | 
|  | } | 
|  | offset = length(divd) - length(divr); | 
|  | if(offset < 0) | 
|  | goto ddone; | 
|  | seekc(p,offset+1); | 
|  | sputc(divd,0); | 
|  | magic = 0; | 
|  | fsfile(divr); | 
|  | c = sbackc(divr); | 
|  | if(c < 10) | 
|  | magic++; | 
|  | c = c * 100 + (sfbeg(divr)?0:sbackc(divr)); | 
|  | if(magic>0){ | 
|  | c = (c * 100 +(sfbeg(divr)?0:sbackc(divr)))*2; | 
|  | c /= 25; | 
|  | } | 
|  | while(offset >= 0) { | 
|  | first++; | 
|  | fsfile(divd); | 
|  | td = sbackc(divd) * 100; | 
|  | dd = sfbeg(divd)?0:sbackc(divd); | 
|  | td = (td + dd) * 100; | 
|  | dd = sfbeg(divd)?0:sbackc(divd); | 
|  | td = td + dd; | 
|  | cc = c; | 
|  | if(offset == 0) | 
|  | td++; | 
|  | else | 
|  | cc++; | 
|  | if(magic != 0) | 
|  | td = td<<3; | 
|  | dig = td/cc; | 
|  | under=0; | 
|  | if(td%cc < 8  && dig > 0 && magic) { | 
|  | dig--; | 
|  | under=1; | 
|  | } | 
|  | rewind(divr); | 
|  | rewind(divxyz); | 
|  | carry = 0; | 
|  | while(sfeof(divr) == 0) { | 
|  | d = sgetc(divr)*dig+carry; | 
|  | carry = d / 100; | 
|  | salterc(divxyz,d%100); | 
|  | } | 
|  | salterc(divxyz,carry); | 
|  | rewind(divxyz); | 
|  | seekc(divd,offset); | 
|  | carry = 0; | 
|  | while(sfeof(divd) == 0) { | 
|  | d = slookc(divd); | 
|  | d = d-(sfeof(divxyz)?0:sgetc(divxyz))-carry; | 
|  | carry = 0; | 
|  | if(d < 0) { | 
|  | d += 100; | 
|  | carry = 1; | 
|  | } | 
|  | salterc(divd,d); | 
|  | } | 
|  | divcarry = carry; | 
|  | backc(p); | 
|  | salterc(p,dig); | 
|  | backc(p); | 
|  | fsfile(divd); | 
|  | d=sbackc(divd); | 
|  | if((d != 0) && /*!divcarry*/ (offset != 0)) { | 
|  | d = sbackc(divd) + 100; | 
|  | salterc(divd,d); | 
|  | } | 
|  | if(--offset >= 0) | 
|  | divd->wt--; | 
|  | } | 
|  | if(under) {	/* undershot last - adjust*/ | 
|  | px = copy(divr,length(divr));	/*11/88 don't corrupt ddivr*/ | 
|  | chsign(px); | 
|  | ps = add(px,divd); | 
|  | fsfile(ps); | 
|  | if(length(ps) > 0 && sbackc(ps) < 0) { | 
|  | release(ps);	/*only adjust in really undershot*/ | 
|  | } else { | 
|  | release(divd); | 
|  | salterc(p, dig+1); | 
|  | divd=ps; | 
|  | } | 
|  | } | 
|  | if(divcarry != 0) { | 
|  | salterc(p,dig-1); | 
|  | salterc(divd,-1); | 
|  | ps = add(divr,divd); | 
|  | release(divd); | 
|  | divd = ps; | 
|  | } | 
|  |  | 
|  | rewind(p); | 
|  | divcarry = 0; | 
|  | while(sfeof(p) == 0){ | 
|  | d = slookc(p)+divcarry; | 
|  | divcarry = 0; | 
|  | if(d >= 100){ | 
|  | d -= 100; | 
|  | divcarry = 1; | 
|  | } | 
|  | salterc(p,d); | 
|  | } | 
|  | if(divcarry != 0)salterc(p,divcarry); | 
|  | fsfile(p); | 
|  | while(sfbeg(p) == 0) { | 
|  | if(sbackc(p) != 0) | 
|  | break; | 
|  | truncate(p); | 
|  | } | 
|  | if(divsign < 0) | 
|  | chsign(p); | 
|  | fsfile(divd); | 
|  | while(sfbeg(divd) == 0) { | 
|  | if(sbackc(divd) != 0) | 
|  | break; | 
|  | truncate(divd); | 
|  | } | 
|  | ddone: | 
|  | if(remsign<0) | 
|  | chsign(divd); | 
|  | if(divr != ddivr) | 
|  | release(divr); | 
|  | rem = divd; | 
|  | return(p); | 
|  | } | 
|  |  | 
|  | int | 
|  | dscale(void) | 
|  | { | 
|  | Blk *dd, *dr, *r; | 
|  | int c; | 
|  |  | 
|  | dr = pop(); | 
|  | EMPTYS; | 
|  | dd = pop(); | 
|  | EMPTYSR(dr); | 
|  | fsfile(dd); | 
|  | skd = sunputc(dd); | 
|  | fsfile(dr); | 
|  | skr = sunputc(dr); | 
|  | if(sfbeg(dr) == 1 || (sfbeg(dr) == 0 && sbackc(dr) == 0)) { | 
|  | sputc(dr,skr); | 
|  | pushp(dr); | 
|  | Bprint(&bout,"divide by 0\n"); | 
|  | return(1); | 
|  | } | 
|  | if(sfbeg(dd) == 1 || (sfbeg(dd) == 0 && sbackc(dd) == 0)) { | 
|  | sputc(dd,skd); | 
|  | pushp(dd); | 
|  | return(1); | 
|  | } | 
|  | c = k-skd+skr; | 
|  | if(c < 0) | 
|  | r = removr(dd,-c); | 
|  | else { | 
|  | r = add0(dd,c); | 
|  | irem = 0; | 
|  | } | 
|  | arg1 = r; | 
|  | arg2 = dr; | 
|  | savk = k; | 
|  | return(0); | 
|  | } | 
|  |  | 
|  | Blk* | 
|  | removr(Blk *p, int n) | 
|  | { | 
|  | int nn, neg; | 
|  | Blk *q, *s, *r; | 
|  |  | 
|  | fsfile(p); | 
|  | neg = sbackc(p); | 
|  | if(neg < 0) | 
|  | chsign(p); | 
|  | rewind(p); | 
|  | nn = (n+1)/2; | 
|  | q = salloc(nn); | 
|  | while(n>1) { | 
|  | sputc(q,sgetc(p)); | 
|  | n -= 2; | 
|  | } | 
|  | r = salloc(2); | 
|  | while(sfeof(p) == 0) | 
|  | sputc(r,sgetc(p)); | 
|  | release(p); | 
|  | if(n == 1){ | 
|  | s = div(r,tenptr); | 
|  | release(r); | 
|  | rewind(rem); | 
|  | if(sfeof(rem) == 0) | 
|  | sputc(q,sgetc(rem)); | 
|  | release(rem); | 
|  | if(neg < 0){ | 
|  | chsign(s); | 
|  | chsign(q); | 
|  | irem = q; | 
|  | return(s); | 
|  | } | 
|  | irem = q; | 
|  | return(s); | 
|  | } | 
|  | if(neg < 0) { | 
|  | chsign(r); | 
|  | chsign(q); | 
|  | irem = q; | 
|  | return(r); | 
|  | } | 
|  | irem = q; | 
|  | return(r); | 
|  | } | 
|  |  | 
|  | Blk* | 
|  | dcsqrt(Blk *p) | 
|  | { | 
|  | Blk *t, *r, *q, *s; | 
|  | int c, n, nn; | 
|  |  | 
|  | n = length(p); | 
|  | fsfile(p); | 
|  | c = sbackc(p); | 
|  | if((n&1) != 1) | 
|  | c = c*100+(sfbeg(p)?0:sbackc(p)); | 
|  | n = (n+1)>>1; | 
|  | r = salloc(n); | 
|  | zero(r); | 
|  | seekc(r,n); | 
|  | nn=1; | 
|  | while((c -= nn)>=0) | 
|  | nn+=2; | 
|  | c=(nn+1)>>1; | 
|  | fsfile(r); | 
|  | backc(r); | 
|  | if(c>=100) { | 
|  | c -= 100; | 
|  | salterc(r,c); | 
|  | sputc(r,1); | 
|  | } else | 
|  | salterc(r,c); | 
|  | for(;;){ | 
|  | q = div(p,r); | 
|  | s = add(q,r); | 
|  | release(q); | 
|  | release(rem); | 
|  | q = div(s,sqtemp); | 
|  | release(s); | 
|  | release(rem); | 
|  | s = copy(r,length(r)); | 
|  | chsign(s); | 
|  | t = add(s,q); | 
|  | release(s); | 
|  | fsfile(t); | 
|  | nn = sfbeg(t)?0:sbackc(t); | 
|  | if(nn>=0) | 
|  | break; | 
|  | release(r); | 
|  | release(t); | 
|  | r = q; | 
|  | } | 
|  | release(t); | 
|  | release(q); | 
|  | release(p); | 
|  | return(r); | 
|  | } | 
|  |  | 
|  | Blk* | 
|  | dcexp(Blk *base, Blk *ex) | 
|  | { | 
|  | Blk *r, *e, *p, *e1, *t, *cp; | 
|  | int temp, c, n; | 
|  |  | 
|  | r = salloc(1); | 
|  | sputc(r,1); | 
|  | p = copy(base,length(base)); | 
|  | e = copy(ex,length(ex)); | 
|  | fsfile(e); | 
|  | if(sfbeg(e) != 0) | 
|  | goto edone; | 
|  | temp=0; | 
|  | c = sbackc(e); | 
|  | if(c<0) { | 
|  | temp++; | 
|  | chsign(e); | 
|  | } | 
|  | while(length(e) != 0) { | 
|  | e1=div(e,sqtemp); | 
|  | release(e); | 
|  | e = e1; | 
|  | n = length(rem); | 
|  | release(rem); | 
|  | if(n != 0) { | 
|  | e1=mult(p,r); | 
|  | release(r); | 
|  | r = e1; | 
|  | } | 
|  | t = copy(p,length(p)); | 
|  | cp = mult(p,t); | 
|  | release(p); | 
|  | release(t); | 
|  | p = cp; | 
|  | } | 
|  | if(temp != 0) { | 
|  | if((c = length(base)) == 0) { | 
|  | goto edone; | 
|  | } | 
|  | if(c>1) | 
|  | create(r); | 
|  | else { | 
|  | rewind(base); | 
|  | if((c = sgetc(base))<=1) { | 
|  | create(r); | 
|  | sputc(r,c); | 
|  | } else | 
|  | create(r); | 
|  | } | 
|  | } | 
|  | edone: | 
|  | release(p); | 
|  | release(e); | 
|  | return(r); | 
|  | } | 
|  |  | 
|  | void | 
|  | init(int argc, char *argv[]) | 
|  | { | 
|  | Sym *sp; | 
|  | Dir *d; | 
|  |  | 
|  | ARGBEGIN { | 
|  | default: | 
|  | dbg = 1; | 
|  | break; | 
|  | } ARGEND | 
|  | ifile = 1; | 
|  | curfile = &bin; | 
|  | if(*argv){ | 
|  | d = dirstat(*argv); | 
|  | if(d == nil) { | 
|  | fprint(2, "dc: can't open file %s\n", *argv); | 
|  | exits("open"); | 
|  | } | 
|  | if(d->mode & DMDIR) { | 
|  | fprint(2, "dc: file %s is a directory\n", *argv); | 
|  | exits("open"); | 
|  | } | 
|  | free(d); | 
|  | if((curfile = Bopen(*argv, OREAD)) == 0) { | 
|  | fprint(2,"dc: can't open file %s\n", *argv); | 
|  | exits("open"); | 
|  | } | 
|  | } | 
|  | /*	dummy = malloc(0);  *//* prepare for garbage-collection */ | 
|  | scalptr = salloc(1); | 
|  | sputc(scalptr,0); | 
|  | basptr = salloc(1); | 
|  | sputc(basptr,10); | 
|  | obase=10; | 
|  | logten=log2(10L); | 
|  | ll=70; | 
|  | fw=1; | 
|  | fw1=0; | 
|  | tenptr = salloc(1); | 
|  | sputc(tenptr,10); | 
|  | obase=10; | 
|  | inbas = salloc(1); | 
|  | sputc(inbas,10); | 
|  | sqtemp = salloc(1); | 
|  | sputc(sqtemp,2); | 
|  | chptr = salloc(0); | 
|  | strptr = salloc(0); | 
|  | divxyz = salloc(0); | 
|  | stkbeg = stkptr = &stack[0]; | 
|  | stkend = &stack[STKSZ]; | 
|  | stkerr = 0; | 
|  | readptr = &readstk[0]; | 
|  | k=0; | 
|  | sp = sptr = &symlst[0]; | 
|  | while(sptr < &symlst[TBLSZ]) { | 
|  | sptr->next = ++sp; | 
|  | sptr++; | 
|  | } | 
|  | sptr->next=0; | 
|  | sfree = &symlst[0]; | 
|  | } | 
|  |  | 
|  | void | 
|  | pushp(Blk *p) | 
|  | { | 
|  | if(stkptr == stkend) { | 
|  | Bprint(&bout,"out of stack space\n"); | 
|  | return; | 
|  | } | 
|  | stkerr=0; | 
|  | *++stkptr = p; | 
|  | return; | 
|  | } | 
|  |  | 
|  | Blk* | 
|  | pop(void) | 
|  | { | 
|  | if(stkptr == stack) { | 
|  | stkerr=1; | 
|  | return(0); | 
|  | } | 
|  | return(*stkptr--); | 
|  | } | 
|  |  | 
|  | Blk* | 
|  | readin(void) | 
|  | { | 
|  | Blk *p, *q; | 
|  | int dp, dpct, c; | 
|  |  | 
|  | dp = dpct=0; | 
|  | p = salloc(0); | 
|  | for(;;){ | 
|  | c = readc(); | 
|  | switch(c) { | 
|  | case '.': | 
|  | if(dp != 0) | 
|  | goto gotnum; | 
|  | dp++; | 
|  | continue; | 
|  | case '\\': | 
|  | readc(); | 
|  | continue; | 
|  | default: | 
|  | if(c >= 'A' && c <= 'F') | 
|  | c = c - 'A' + 10; | 
|  | else | 
|  | if(c >= '0' && c <= '9') | 
|  | c -= '0'; | 
|  | else | 
|  | goto gotnum; | 
|  | if(dp != 0) { | 
|  | if(dpct >= 99) | 
|  | continue; | 
|  | dpct++; | 
|  | } | 
|  | create(chptr); | 
|  | if(c != 0) | 
|  | sputc(chptr,c); | 
|  | q = mult(p,inbas); | 
|  | release(p); | 
|  | p = add(chptr,q); | 
|  | release(q); | 
|  | } | 
|  | } | 
|  | gotnum: | 
|  | unreadc(c); | 
|  | if(dp == 0) { | 
|  | sputc(p,0); | 
|  | return(p); | 
|  | } else { | 
|  | q = scale(p,dpct); | 
|  | return(q); | 
|  | } | 
|  | } | 
|  |  | 
|  | /* | 
|  | * returns pointer to struct with ct 0's & p | 
|  | */ | 
|  | Blk* | 
|  | add0(Blk *p, int ct) | 
|  | { | 
|  | Blk *q, *t; | 
|  |  | 
|  | q = salloc(length(p)+(ct+1)/2); | 
|  | while(ct>1) { | 
|  | sputc(q,0); | 
|  | ct -= 2; | 
|  | } | 
|  | rewind(p); | 
|  | while(sfeof(p) == 0) { | 
|  | sputc(q,sgetc(p)); | 
|  | } | 
|  | release(p); | 
|  | if(ct == 1) { | 
|  | t = mult(tenptr,q); | 
|  | release(q); | 
|  | return(t); | 
|  | } | 
|  | return(q); | 
|  | } | 
|  |  | 
|  | Blk* | 
|  | mult(Blk *p, Blk *q) | 
|  | { | 
|  | Blk *mp, *mq, *mr; | 
|  | int sign, offset, carry; | 
|  | int cq, cp, mt, mcr; | 
|  |  | 
|  | offset = sign = 0; | 
|  | fsfile(p); | 
|  | mp = p; | 
|  | if(sfbeg(p) == 0) { | 
|  | if(sbackc(p)<0) { | 
|  | mp = copy(p,length(p)); | 
|  | chsign(mp); | 
|  | sign = ~sign; | 
|  | } | 
|  | } | 
|  | fsfile(q); | 
|  | mq = q; | 
|  | if(sfbeg(q) == 0){ | 
|  | if(sbackc(q)<0) { | 
|  | mq = copy(q,length(q)); | 
|  | chsign(mq); | 
|  | sign = ~sign; | 
|  | } | 
|  | } | 
|  | mr = salloc(length(mp)+length(mq)); | 
|  | zero(mr); | 
|  | rewind(mq); | 
|  | while(sfeof(mq) == 0) { | 
|  | cq = sgetc(mq); | 
|  | rewind(mp); | 
|  | rewind(mr); | 
|  | mr->rd += offset; | 
|  | carry=0; | 
|  | while(sfeof(mp) == 0) { | 
|  | cp = sgetc(mp); | 
|  | mcr = sfeof(mr)?0:slookc(mr); | 
|  | mt = cp*cq + carry + mcr; | 
|  | carry = mt/100; | 
|  | salterc(mr,mt%100); | 
|  | } | 
|  | offset++; | 
|  | if(carry != 0) { | 
|  | mcr = sfeof(mr)?0:slookc(mr); | 
|  | salterc(mr,mcr+carry); | 
|  | } | 
|  | } | 
|  | if(sign < 0) { | 
|  | chsign(mr); | 
|  | } | 
|  | if(mp != p) | 
|  | release(mp); | 
|  | if(mq != q) | 
|  | release(mq); | 
|  | return(mr); | 
|  | } | 
|  |  | 
|  | void | 
|  | chsign(Blk *p) | 
|  | { | 
|  | int carry; | 
|  | char ct; | 
|  |  | 
|  | carry=0; | 
|  | rewind(p); | 
|  | while(sfeof(p) == 0) { | 
|  | ct=100-slookc(p)-carry; | 
|  | carry=1; | 
|  | if(ct>=100) { | 
|  | ct -= 100; | 
|  | carry=0; | 
|  | } | 
|  | salterc(p,ct); | 
|  | } | 
|  | if(carry != 0) { | 
|  | sputc(p,-1); | 
|  | fsfile(p); | 
|  | backc(p); | 
|  | ct = sbackc(p); | 
|  | if(ct == 99 /*&& !sfbeg(p)*/) { | 
|  | truncate(p); | 
|  | sputc(p,-1); | 
|  | } | 
|  | } else{ | 
|  | fsfile(p); | 
|  | ct = sbackc(p); | 
|  | if(ct == 0) | 
|  | truncate(p); | 
|  | } | 
|  | return; | 
|  | } | 
|  |  | 
|  | int | 
|  | readc(void) | 
|  | { | 
|  | loop: | 
|  | if((readptr != &readstk[0]) && (*readptr != 0)) { | 
|  | if(sfeof(*readptr) == 0) | 
|  | return(lastchar = sgetc(*readptr)); | 
|  | release(*readptr); | 
|  | readptr--; | 
|  | goto loop; | 
|  | } | 
|  | lastchar = Bgetc(curfile); | 
|  | if(lastchar != -1) | 
|  | return(lastchar); | 
|  | if(readptr != &readptr[0]) { | 
|  | readptr--; | 
|  | if(*readptr == 0) | 
|  | curfile = &bin; | 
|  | goto loop; | 
|  | } | 
|  | if(curfile != &bin) { | 
|  | Bterm(curfile); | 
|  | curfile = &bin; | 
|  | goto loop; | 
|  | } | 
|  | exits(0); | 
|  | return 0;	/* shut up ken */ | 
|  | } | 
|  |  | 
|  | void | 
|  | unreadc(char c) | 
|  | { | 
|  |  | 
|  | if((readptr != &readstk[0]) && (*readptr != 0)) { | 
|  | sungetc(*readptr,c); | 
|  | } else | 
|  | Bungetc(curfile); | 
|  | return; | 
|  | } | 
|  |  | 
|  | void | 
|  | binop(char c) | 
|  | { | 
|  | Blk *r; | 
|  |  | 
|  | r = 0; | 
|  | switch(c) { | 
|  | case '+': | 
|  | r = add(arg1,arg2); | 
|  | break; | 
|  | case '*': | 
|  | r = mult(arg1,arg2); | 
|  | break; | 
|  | case '/': | 
|  | r = div(arg1,arg2); | 
|  | break; | 
|  | } | 
|  | release(arg1); | 
|  | release(arg2); | 
|  | sputc(r,savk); | 
|  | pushp(r); | 
|  | } | 
|  |  | 
|  | void | 
|  | dcprint(Blk *hptr) | 
|  | { | 
|  | Blk *p, *q, *dec; | 
|  | int dig, dout, ct, sc; | 
|  |  | 
|  | rewind(hptr); | 
|  | while(sfeof(hptr) == 0) { | 
|  | if(sgetc(hptr)>99) { | 
|  | rewind(hptr); | 
|  | while(sfeof(hptr) == 0) { | 
|  | Bprint(&bout,"%c",sgetc(hptr)); | 
|  | } | 
|  | Bprint(&bout,"\n"); | 
|  | return; | 
|  | } | 
|  | } | 
|  | fsfile(hptr); | 
|  | sc = sbackc(hptr); | 
|  | if(sfbeg(hptr) != 0) { | 
|  | Bprint(&bout,"0\n"); | 
|  | return; | 
|  | } | 
|  | count = ll; | 
|  | p = copy(hptr,length(hptr)); | 
|  | sclobber(p); | 
|  | fsfile(p); | 
|  | if(sbackc(p)<0) { | 
|  | chsign(p); | 
|  | OUTC('-'); | 
|  | } | 
|  | if((obase == 0) || (obase == -1)) { | 
|  | oneot(p,sc,'d'); | 
|  | return; | 
|  | } | 
|  | if(obase == 1) { | 
|  | oneot(p,sc,'1'); | 
|  | return; | 
|  | } | 
|  | if(obase == 10) { | 
|  | tenot(p,sc); | 
|  | return; | 
|  | } | 
|  | /* sleazy hack to scale top of stack - divide by 1 */ | 
|  | pushp(p); | 
|  | sputc(p, sc); | 
|  | p=salloc(0); | 
|  | create(p); | 
|  | sputc(p, 1); | 
|  | sputc(p, 0); | 
|  | pushp(p); | 
|  | if(dscale() != 0) | 
|  | return; | 
|  | p = div(arg1, arg2); | 
|  | release(arg1); | 
|  | release(arg2); | 
|  | sc = savk; | 
|  |  | 
|  | create(strptr); | 
|  | dig = logten*sc; | 
|  | dout = ((dig/10) + dig) / logo; | 
|  | dec = getdec(p,sc); | 
|  | p = removc(p,sc); | 
|  | while(length(p) != 0) { | 
|  | q = div(p,basptr); | 
|  | release(p); | 
|  | p = q; | 
|  | (*outdit)(rem,0); | 
|  | } | 
|  | release(p); | 
|  | fsfile(strptr); | 
|  | while(sfbeg(strptr) == 0) | 
|  | OUTC(sbackc(strptr)); | 
|  | if(sc == 0) { | 
|  | release(dec); | 
|  | Bprint(&bout,"\n"); | 
|  | return; | 
|  | } | 
|  | create(strptr); | 
|  | OUTC('.'); | 
|  | ct=0; | 
|  | do { | 
|  | q = mult(basptr,dec); | 
|  | release(dec); | 
|  | dec = getdec(q,sc); | 
|  | p = removc(q,sc); | 
|  | (*outdit)(p,1); | 
|  | } while(++ct < dout); | 
|  | release(dec); | 
|  | rewind(strptr); | 
|  | while(sfeof(strptr) == 0) | 
|  | OUTC(sgetc(strptr)); | 
|  | Bprint(&bout,"\n"); | 
|  | } | 
|  |  | 
|  | Blk* | 
|  | getdec(Blk *p, int sc) | 
|  | { | 
|  | int cc; | 
|  | Blk *q, *t, *s; | 
|  |  | 
|  | rewind(p); | 
|  | if(length(p)*2 < sc) { | 
|  | q = copy(p,length(p)); | 
|  | return(q); | 
|  | } | 
|  | q = salloc(length(p)); | 
|  | while(sc >= 1) { | 
|  | sputc(q,sgetc(p)); | 
|  | sc -= 2; | 
|  | } | 
|  | if(sc != 0) { | 
|  | t = mult(q,tenptr); | 
|  | s = salloc(cc = length(q)); | 
|  | release(q); | 
|  | rewind(t); | 
|  | while(cc-- > 0) | 
|  | sputc(s,sgetc(t)); | 
|  | sputc(s,0); | 
|  | release(t); | 
|  | t = div(s,tenptr); | 
|  | release(s); | 
|  | release(rem); | 
|  | return(t); | 
|  | } | 
|  | return(q); | 
|  | } | 
|  |  | 
|  | void | 
|  | tenot(Blk *p, int sc) | 
|  | { | 
|  | int c, f; | 
|  |  | 
|  | fsfile(p); | 
|  | f=0; | 
|  | while((sfbeg(p) == 0) && ((p->rd-p->beg-1)*2 >= sc)) { | 
|  | c = sbackc(p); | 
|  | if((c<10) && (f == 1)) | 
|  | Bprint(&bout,"0%d",c); | 
|  | else | 
|  | Bprint(&bout,"%d",c); | 
|  | f=1; | 
|  | TEST2; | 
|  | } | 
|  | if(sc == 0) { | 
|  | Bprint(&bout,"\n"); | 
|  | release(p); | 
|  | return; | 
|  | } | 
|  | if((p->rd-p->beg)*2 > sc) { | 
|  | c = sbackc(p); | 
|  | Bprint(&bout,"%d.",c/10); | 
|  | TEST2; | 
|  | OUTC(c%10 +'0'); | 
|  | sc--; | 
|  | } else { | 
|  | OUTC('.'); | 
|  | } | 
|  | while(sc>(p->rd-p->beg)*2) { | 
|  | OUTC('0'); | 
|  | sc--; | 
|  | } | 
|  | while(sc > 1) { | 
|  | c = sbackc(p); | 
|  | if(c<10) | 
|  | Bprint(&bout,"0%d",c); | 
|  | else | 
|  | Bprint(&bout,"%d",c); | 
|  | sc -= 2; | 
|  | TEST2; | 
|  | } | 
|  | if(sc == 1) { | 
|  | OUTC(sbackc(p)/10 +'0'); | 
|  | } | 
|  | Bprint(&bout,"\n"); | 
|  | release(p); | 
|  | } | 
|  |  | 
|  | void | 
|  | oneot(Blk *p, int sc, char ch) | 
|  | { | 
|  | Blk *q; | 
|  |  | 
|  | q = removc(p,sc); | 
|  | create(strptr); | 
|  | sputc(strptr,-1); | 
|  | while(length(q)>0) { | 
|  | p = add(strptr,q); | 
|  | release(q); | 
|  | q = p; | 
|  | OUTC(ch); | 
|  | } | 
|  | release(q); | 
|  | Bprint(&bout,"\n"); | 
|  | } | 
|  |  | 
|  | void | 
|  | hexot(Blk *p, int flg) | 
|  | { | 
|  | int c; | 
|  |  | 
|  | USED(flg); | 
|  | rewind(p); | 
|  | if(sfeof(p) != 0) { | 
|  | sputc(strptr,'0'); | 
|  | release(p); | 
|  | return; | 
|  | } | 
|  | c = sgetc(p); | 
|  | release(p); | 
|  | if(c >= 16) { | 
|  | Bprint(&bout,"hex digit > 16"); | 
|  | return; | 
|  | } | 
|  | sputc(strptr,c<10?c+'0':c-10+'a'); | 
|  | } | 
|  |  | 
|  | void | 
|  | bigot(Blk *p, int flg) | 
|  | { | 
|  | Blk *t, *q; | 
|  | int neg, l; | 
|  |  | 
|  | if(flg == 1) { | 
|  | t = salloc(0); | 
|  | l = 0; | 
|  | } else { | 
|  | t = strptr; | 
|  | l = length(strptr)+fw-1; | 
|  | } | 
|  | neg=0; | 
|  | if(length(p) != 0) { | 
|  | fsfile(p); | 
|  | if(sbackc(p)<0) { | 
|  | neg=1; | 
|  | chsign(p); | 
|  | } | 
|  | while(length(p) != 0) { | 
|  | q = div(p,tenptr); | 
|  | release(p); | 
|  | p = q; | 
|  | rewind(rem); | 
|  | sputc(t,sfeof(rem)?'0':sgetc(rem)+'0'); | 
|  | release(rem); | 
|  | } | 
|  | } | 
|  | release(p); | 
|  | if(flg == 1) { | 
|  | l = fw1-length(t); | 
|  | if(neg != 0) { | 
|  | l--; | 
|  | sputc(strptr,'-'); | 
|  | } | 
|  | fsfile(t); | 
|  | while(l-- > 0) | 
|  | sputc(strptr,'0'); | 
|  | while(sfbeg(t) == 0) | 
|  | sputc(strptr,sbackc(t)); | 
|  | release(t); | 
|  | } else { | 
|  | l -= length(strptr); | 
|  | while(l-- > 0) | 
|  | sputc(strptr,'0'); | 
|  | if(neg != 0) { | 
|  | sclobber(strptr); | 
|  | sputc(strptr,'-'); | 
|  | } | 
|  | } | 
|  | sputc(strptr,' '); | 
|  | } | 
|  |  | 
|  | Blk* | 
|  | add(Blk *a1, Blk *a2) | 
|  | { | 
|  | Blk *p; | 
|  | int carry, n, size, c, n1, n2; | 
|  |  | 
|  | size = length(a1)>length(a2)?length(a1):length(a2); | 
|  | p = salloc(size); | 
|  | rewind(a1); | 
|  | rewind(a2); | 
|  | carry=0; | 
|  | while(--size >= 0) { | 
|  | n1 = sfeof(a1)?0:sgetc(a1); | 
|  | n2 = sfeof(a2)?0:sgetc(a2); | 
|  | n = n1 + n2 + carry; | 
|  | if(n>=100) { | 
|  | carry=1; | 
|  | n -= 100; | 
|  | } else | 
|  | if(n<0) { | 
|  | carry = -1; | 
|  | n += 100; | 
|  | } else | 
|  | carry = 0; | 
|  | sputc(p,n); | 
|  | } | 
|  | if(carry != 0) | 
|  | sputc(p,carry); | 
|  | fsfile(p); | 
|  | if(sfbeg(p) == 0) { | 
|  | c = 0; | 
|  | while(sfbeg(p) == 0 && (c = sbackc(p)) == 0) | 
|  | ; | 
|  | if(c != 0) | 
|  | salterc(p,c); | 
|  | truncate(p); | 
|  | } | 
|  | fsfile(p); | 
|  | if(sfbeg(p) == 0 && sbackc(p) == -1) { | 
|  | while((c = sbackc(p)) == 99) { | 
|  | if(c == -1) | 
|  | break; | 
|  | } | 
|  | skipc(p); | 
|  | salterc(p,-1); | 
|  | truncate(p); | 
|  | } | 
|  | return(p); | 
|  | } | 
|  |  | 
|  | int | 
|  | eqk(void) | 
|  | { | 
|  | Blk *p, *q; | 
|  | int skp, skq; | 
|  |  | 
|  | p = pop(); | 
|  | EMPTYS; | 
|  | q = pop(); | 
|  | EMPTYSR(p); | 
|  | skp = sunputc(p); | 
|  | skq = sunputc(q); | 
|  | if(skp == skq) { | 
|  | arg1=p; | 
|  | arg2=q; | 
|  | savk = skp; | 
|  | return(0); | 
|  | } | 
|  | if(skp < skq) { | 
|  | savk = skq; | 
|  | p = add0(p,skq-skp); | 
|  | } else { | 
|  | savk = skp; | 
|  | q = add0(q,skp-skq); | 
|  | } | 
|  | arg1=p; | 
|  | arg2=q; | 
|  | return(0); | 
|  | } | 
|  |  | 
|  | Blk* | 
|  | removc(Blk *p, int n) | 
|  | { | 
|  | Blk *q, *r; | 
|  |  | 
|  | rewind(p); | 
|  | while(n>1) { | 
|  | skipc(p); | 
|  | n -= 2; | 
|  | } | 
|  | q = salloc(2); | 
|  | while(sfeof(p) == 0) | 
|  | sputc(q,sgetc(p)); | 
|  | if(n == 1) { | 
|  | r = div(q,tenptr); | 
|  | release(q); | 
|  | release(rem); | 
|  | q = r; | 
|  | } | 
|  | release(p); | 
|  | return(q); | 
|  | } | 
|  |  | 
|  | Blk* | 
|  | scalint(Blk *p) | 
|  | { | 
|  | int n; | 
|  |  | 
|  | n = sunputc(p); | 
|  | p = removc(p,n); | 
|  | return(p); | 
|  | } | 
|  |  | 
|  | Blk* | 
|  | scale(Blk *p, int n) | 
|  | { | 
|  | Blk *q, *s, *t; | 
|  |  | 
|  | t = add0(p,n); | 
|  | q = salloc(1); | 
|  | sputc(q,n); | 
|  | s = dcexp(inbas,q); | 
|  | release(q); | 
|  | q = div(t,s); | 
|  | release(t); | 
|  | release(s); | 
|  | release(rem); | 
|  | sputc(q,n); | 
|  | return(q); | 
|  | } | 
|  |  | 
|  | int | 
|  | subt(void) | 
|  | { | 
|  | arg1=pop(); | 
|  | EMPTYS; | 
|  | savk = sunputc(arg1); | 
|  | chsign(arg1); | 
|  | sputc(arg1,savk); | 
|  | pushp(arg1); | 
|  | if(eqk() != 0) | 
|  | return(1); | 
|  | binop('+'); | 
|  | return(0); | 
|  | } | 
|  |  | 
|  | int | 
|  | command(void) | 
|  | { | 
|  | char line[100], *sl; | 
|  | int pid, p, c; | 
|  |  | 
|  | switch(c = readc()) { | 
|  | case '<': | 
|  | return(cond(NL)); | 
|  | case '>': | 
|  | return(cond(NG)); | 
|  | case '=': | 
|  | return(cond(NE)); | 
|  | default: | 
|  | sl = line; | 
|  | *sl++ = c; | 
|  | while((c = readc()) != '\n') | 
|  | *sl++ = c; | 
|  | *sl = 0; | 
|  | if((pid = fork()) == 0) { | 
|  | execl("/bin/rc","rc","-c",line,0); | 
|  | exits("shell"); | 
|  | } | 
|  | for(;;) { | 
|  | if((p = waitpid()) < 0) | 
|  | break; | 
|  | if(p== pid) | 
|  | break; | 
|  | } | 
|  | Bprint(&bout,"!\n"); | 
|  | return(0); | 
|  | } | 
|  | } | 
|  |  | 
|  | int | 
|  | cond(char c) | 
|  | { | 
|  | Blk *p; | 
|  | int cc; | 
|  |  | 
|  | if(subt() != 0) | 
|  | return(1); | 
|  | p = pop(); | 
|  | sclobber(p); | 
|  | if(length(p) == 0) { | 
|  | release(p); | 
|  | if(c == '<' || c == '>' || c == NE) { | 
|  | getstk(); | 
|  | return(0); | 
|  | } | 
|  | load(); | 
|  | return(1); | 
|  | } | 
|  | if(c == '='){ | 
|  | release(p); | 
|  | getstk(); | 
|  | return(0); | 
|  | } | 
|  | if(c == NE) { | 
|  | release(p); | 
|  | load(); | 
|  | return(1); | 
|  | } | 
|  | fsfile(p); | 
|  | cc = sbackc(p); | 
|  | release(p); | 
|  | if((cc<0 && (c == '<' || c == NG)) || | 
|  | (cc >0) && (c == '>' || c == NL)) { | 
|  | getstk(); | 
|  | return(0); | 
|  | } | 
|  | load(); | 
|  | return(1); | 
|  | } | 
|  |  | 
|  | void | 
|  | load(void) | 
|  | { | 
|  | int c; | 
|  | Blk *p, *q, *t, *s; | 
|  |  | 
|  | c = getstk() & 0377; | 
|  | sptr = stable[c]; | 
|  | if(sptr != 0) { | 
|  | p = sptr->val; | 
|  | if(c >= ARRAYST) { | 
|  | q = salloc(length(p)); | 
|  | rewind(p); | 
|  | while(sfeof(p) == 0) { | 
|  | s = dcgetwd(p); | 
|  | if(s == 0) { | 
|  | putwd(q, (Blk*)0); | 
|  | } else { | 
|  | t = copy(s,length(s)); | 
|  | putwd(q,t); | 
|  | } | 
|  | } | 
|  | pushp(q); | 
|  | } else { | 
|  | q = copy(p,length(p)); | 
|  | pushp(q); | 
|  | } | 
|  | } else { | 
|  | q = salloc(1); | 
|  | if(c <= LASTFUN) { | 
|  | Bprint(&bout,"function %c undefined\n",c+'a'-1); | 
|  | sputc(q,'c'); | 
|  | sputc(q,'0'); | 
|  | sputc(q,' '); | 
|  | sputc(q,'1'); | 
|  | sputc(q,'Q'); | 
|  | } | 
|  | else | 
|  | sputc(q,0); | 
|  | pushp(q); | 
|  | } | 
|  | } | 
|  |  | 
|  | int | 
|  | log2(long n) | 
|  | { | 
|  | int i; | 
|  |  | 
|  | if(n == 0) | 
|  | return(0); | 
|  | i=31; | 
|  | if(n<0) | 
|  | return(i); | 
|  | while((n= n<<1) >0) | 
|  | i--; | 
|  | return i-1; | 
|  | } | 
|  |  | 
|  | Blk* | 
|  | salloc(int size) | 
|  | { | 
|  | Blk *hdr; | 
|  | char *ptr; | 
|  |  | 
|  | all++; | 
|  | lall++; | 
|  | if(all - rel > active) | 
|  | active = all - rel; | 
|  | nbytes += size; | 
|  | lbytes += size; | 
|  | if(nbytes >maxsize) | 
|  | maxsize = nbytes; | 
|  | if(size > longest) | 
|  | longest = size; | 
|  | ptr = malloc((unsigned)size); | 
|  | if(ptr == 0){ | 
|  | garbage("salloc"); | 
|  | if((ptr = malloc((unsigned)size)) == 0) | 
|  | ospace("salloc"); | 
|  | } | 
|  | if((hdr = hfree) == 0) | 
|  | hdr = morehd(); | 
|  | hfree = (Blk *)hdr->rd; | 
|  | hdr->rd = hdr->wt = hdr->beg = ptr; | 
|  | hdr->last = ptr+size; | 
|  | return(hdr); | 
|  | } | 
|  |  | 
|  | Blk* | 
|  | morehd(void) | 
|  | { | 
|  | Blk *h, *kk; | 
|  |  | 
|  | headmor++; | 
|  | nbytes += HEADSZ; | 
|  | hfree = h = (Blk *)malloc(HEADSZ); | 
|  | if(hfree == 0) { | 
|  | garbage("morehd"); | 
|  | if((hfree = h = (Blk*)malloc(HEADSZ)) == 0) | 
|  | ospace("headers"); | 
|  | } | 
|  | kk = h; | 
|  | while(h<hfree+(HEADSZ/BLK)) | 
|  | (h++)->rd = (char*)++kk; | 
|  | (h-1)->rd=0; | 
|  | return(hfree); | 
|  | } | 
|  |  | 
|  | Blk* | 
|  | copy(Blk *hptr, int size) | 
|  | { | 
|  | Blk *hdr; | 
|  | unsigned sz; | 
|  | char *ptr; | 
|  |  | 
|  | all++; | 
|  | lall++; | 
|  | lcopy++; | 
|  | nbytes += size; | 
|  | lbytes += size; | 
|  | if(size > longest) | 
|  | longest = size; | 
|  | if(size > maxsize) | 
|  | maxsize = size; | 
|  | sz = length(hptr); | 
|  | ptr = nalloc(hptr->beg, size); | 
|  | if(ptr == 0) { | 
|  | garbage("copy"); | 
|  | if((ptr = nalloc(hptr->beg, size)) == 0) { | 
|  | Bprint(&bout,"copy size %d\n",size); | 
|  | ospace("copy"); | 
|  | } | 
|  | } | 
|  | if((hdr = hfree) == 0) | 
|  | hdr = morehd(); | 
|  | hfree = (Blk *)hdr->rd; | 
|  | hdr->rd = hdr->beg = ptr; | 
|  | hdr->last = ptr+size; | 
|  | hdr->wt = ptr+sz; | 
|  | ptr = hdr->wt; | 
|  | while(ptr<hdr->last) | 
|  | *ptr++ = '\0'; | 
|  | return(hdr); | 
|  | } | 
|  |  | 
|  | void | 
|  | sdump(char *s1, Blk *hptr) | 
|  | { | 
|  | char *p; | 
|  |  | 
|  | Bprint(&bout,"%s %lx rd %lx wt %lx beg %lx last %lx\n", | 
|  | s1,hptr,hptr->rd,hptr->wt,hptr->beg,hptr->last); | 
|  | p = hptr->beg; | 
|  | while(p < hptr->wt) | 
|  | Bprint(&bout,"%d ",*p++); | 
|  | Bprint(&bout,"\n"); | 
|  | } | 
|  |  | 
|  | void | 
|  | seekc(Blk *hptr, int n) | 
|  | { | 
|  | char *nn,*p; | 
|  |  | 
|  | nn = hptr->beg+n; | 
|  | if(nn > hptr->last) { | 
|  | nbytes += nn - hptr->last; | 
|  | if(nbytes > maxsize) | 
|  | maxsize = nbytes; | 
|  | lbytes += nn - hptr->last; | 
|  | if(n > longest) | 
|  | longest = n; | 
|  | /*		free(hptr->beg); *//**/ | 
|  | p = realloc(hptr->beg, n); | 
|  | if(p == 0) { | 
|  | /*			hptr->beg = realloc(hptr->beg, hptr->last-hptr->beg); | 
|  | **			garbage("seekc"); | 
|  | **			if((p = realloc(hptr->beg, n)) == 0) | 
|  | */				ospace("seekc"); | 
|  | } | 
|  | hptr->beg = p; | 
|  | hptr->wt = hptr->last = hptr->rd = p+n; | 
|  | return; | 
|  | } | 
|  | hptr->rd = nn; | 
|  | if(nn>hptr->wt) | 
|  | hptr->wt = nn; | 
|  | } | 
|  |  | 
|  | void | 
|  | salterwd(Blk *ahptr, Blk *n) | 
|  | { | 
|  | Wblk *hptr; | 
|  |  | 
|  | hptr = (Wblk*)ahptr; | 
|  | if(hptr->rdw == hptr->lastw) | 
|  | more(ahptr); | 
|  | *hptr->rdw++ = n; | 
|  | if(hptr->rdw > hptr->wtw) | 
|  | hptr->wtw = hptr->rdw; | 
|  | } | 
|  |  | 
|  | void | 
|  | more(Blk *hptr) | 
|  | { | 
|  | unsigned size; | 
|  | char *p; | 
|  |  | 
|  | if((size=(hptr->last-hptr->beg)*2) == 0) | 
|  | size=2; | 
|  | nbytes += size/2; | 
|  | if(nbytes > maxsize) | 
|  | maxsize = nbytes; | 
|  | if(size > longest) | 
|  | longest = size; | 
|  | lbytes += size/2; | 
|  | lmore++; | 
|  | /*	free(hptr->beg);*//**/ | 
|  | p = realloc(hptr->beg, size); | 
|  |  | 
|  | if(p == 0) { | 
|  | /*		hptr->beg = realloc(hptr->beg, (hptr->last-hptr->beg)); | 
|  | **		garbage("more"); | 
|  | **		if((p = realloc(hptr->beg,size)) == 0) | 
|  | */			ospace("more"); | 
|  | } | 
|  | hptr->rd = p + (hptr->rd - hptr->beg); | 
|  | hptr->wt = p + (hptr->wt - hptr->beg); | 
|  | hptr->beg = p; | 
|  | hptr->last = p+size; | 
|  | } | 
|  |  | 
|  | void | 
|  | ospace(char *s) | 
|  | { | 
|  | Bprint(&bout,"out of space: %s\n",s); | 
|  | Bprint(&bout,"all %ld rel %ld headmor %ld\n",all,rel,headmor); | 
|  | Bprint(&bout,"nbytes %ld\n",nbytes); | 
|  | sdump("stk",*stkptr); | 
|  | abort(); | 
|  | } | 
|  |  | 
|  | void | 
|  | garbage(char *s) | 
|  | { | 
|  | USED(s); | 
|  | } | 
|  |  | 
|  | void | 
|  | release(Blk *p) | 
|  | { | 
|  | rel++; | 
|  | lrel++; | 
|  | nbytes -= p->last - p->beg; | 
|  | p->rd = (char*)hfree; | 
|  | hfree = p; | 
|  | free(p->beg); | 
|  | } | 
|  |  | 
|  | Blk* | 
|  | dcgetwd(Blk *p) | 
|  | { | 
|  | Wblk *wp; | 
|  |  | 
|  | wp = (Wblk*)p; | 
|  | if(wp->rdw == wp->wtw) | 
|  | return(0); | 
|  | return(*wp->rdw++); | 
|  | } | 
|  |  | 
|  | void | 
|  | putwd(Blk *p, Blk *c) | 
|  | { | 
|  | Wblk *wp; | 
|  |  | 
|  | wp = (Wblk*)p; | 
|  | if(wp->wtw == wp->lastw) | 
|  | more(p); | 
|  | *wp->wtw++ = c; | 
|  | } | 
|  |  | 
|  | Blk* | 
|  | lookwd(Blk *p) | 
|  | { | 
|  | Wblk *wp; | 
|  |  | 
|  | wp = (Wblk*)p; | 
|  | if(wp->rdw == wp->wtw) | 
|  | return(0); | 
|  | return(*wp->rdw); | 
|  | } | 
|  |  | 
|  | char* | 
|  | nalloc(char *p, unsigned nbytes) | 
|  | { | 
|  | char *q, *r; | 
|  |  | 
|  | q = r = malloc(nbytes); | 
|  | if(q==0) | 
|  | return(0); | 
|  | while(nbytes--) | 
|  | *q++ = *p++; | 
|  | return(r); | 
|  | } | 
|  |  | 
|  | int | 
|  | getstk(void) | 
|  | { | 
|  | int n; | 
|  | uchar c; | 
|  |  | 
|  | c = readc(); | 
|  | if(c != '<') | 
|  | return c; | 
|  | n = 0; | 
|  | while(1) { | 
|  | c = readc(); | 
|  | if(c == '>') | 
|  | break; | 
|  | n = n*10+c-'0'; | 
|  | } | 
|  | return n; | 
|  | } |