2294 lines · 35.6 KB · C
RawDownload
#include <u.h>#include <libc.h>#include <bio.h> typedef	void*	pointer;#pragma	varargck	type	"lx"	pointer #define FATAL 0#define NFATAL 1#define BLK sizeof(Blk)#define PTRSZ sizeof(int*)#define TBLSZ 256			/* 1<<BI2BY */ #define HEADSZ 1024#define STKSZ 100#define RDSKSZ 100#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#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);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);int	getstk(void); /********debug only**/voidtpr(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");}/************/ voidmain(int argc, char *argv[]){	Binit(&bin, 0, OREAD);	Binit(&bout, 1, OWRITE);	init(argc,argv);	commnds();	exits(0);} voidcommnds(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 '\t':		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);

Lines 1–500 of 2294.