#include "fio.h"#include "fmt.h"#define skip(s) while(*s==' ') s++#ifdef interdata#define SYLMX 300#endif#ifdef pdp11#define SYLMX 300#endif#ifdef vax#define SYLMX 300#endif#define GLITCH '\2'	/* special quote character for stu */extern int cursor,scale;extern flag cblank,cplus;	/*blanks in I and compulsory plus*/struct syl syl[SYLMX];int parenlvl,pc,revloc;char *f_s(),*f_list(),*i_tem(),*gt_num();pars_f(s) char *s;{	parenlvl=revloc=pc=0;	if((s=f_s(s,0))==NULL)	{		return(-1);	}	return(0);}char *f_s(s,curloc) char *s;{	skip(s);	if(*s++!='(')	{		return(NULL);	}	if(parenlvl++ ==1) revloc=curloc;	if(op_gen(RET,curloc,0,0)<0 ||		(s=f_list(s))==NULL)	{		return(NULL);	}	skip(s);	return(s);}char *f_list(s) char *s;{	for(;*s!=0;)	{	skip(s);		if((s=i_tem(s))==NULL) return(NULL);		skip(s);		if(*s==',') s++;		else if(*s==')')		{	if(--parenlvl==0)			{				op_gen(REVERT,revloc,0,0);				return(++s);			}			op_gen(GOTO,0,0,0);			return(++s);		}	}	return(NULL);}char *i_tem(s) char *s;{	char *t;	int n,curloc;	if(*s==')') return(s);	if(ne_d(s,&t)) return(t);	if(e_d(s,&t)) return(t);	s=gt_num(s,&n);	if((curloc=op_gen(STACK,n,0,0))<0) return(NULL);	return(f_s(s,curloc));}ne_d(s,p) char *s,**p;{	int n,x,sign=0;	char *ap_end();	switch(*s)	{	default: return(0);	case ':': op_gen(COLON,0,0,0); break;	case 'b':		if(*++s=='z') op_gen(BZ,0,0,0);		else op_gen(BN,0,0,0);		break;	case 's':		if(*(s+1)=='s')		{	x=SS;			s++;		}		else if(*(s+1)=='p')		{	x=SP;			s++;		}		else x=S;		op_gen(x,0,0,0);		break;	case '/': op_gen(SLASH,0,0,0); break;	case '-': sign=1; s++;	/*OUTRAGEOUS CODING TRICK*/	case '0': case '1': case '2': case '3': case '4':	case '5': case '6': case '7': case '8': case '9':		s=gt_num(s,&n);		switch(*s)		{		default: return(0);		case 'p': if(sign) n= -n; op_gen(P,n,0,0); break;		case 'x': op_gen(X,n,0,0); break;		case 'H':		case 'h': op_gen(H,n,(int)(s+1),0);			s+=n;			break;		}		break;	case GLITCH:	case '"':	case '\'': op_gen(APOS,(int)s,0,0);		*p=ap_end(s);		return(1);	case 't':		if(*(s+1)=='l')		{	x=TL;			s++;		}		else if(*(s+1)=='r')		{	x=TR;			s++;		}		else x=T;		s=gt_num(s+1,&n);		op_gen(x,n,0,0);		break;	case 'x': op_gen(X,1,0,0); break;	case 'p': op_gen(P,1,0,0); break;	}	s++;	*p=s;	return(1);}e_d(s,p) char *s,**p;{	int n,w,d,e,found=0,x=0;	char *sv=s;	s=gt_num(s,&n);	op_gen(STACK,n,0,0);	switch(*s++)	{	default: break;	case 'e':	x=1;	case 'g':		found=1;		s=gt_num(s,&w);		if(w==0) break;		if(*s=='.')		{	s++;			s=gt_num(s,&d);		}		else d=0;		if(*s!='E')			op_gen(x==1?E:G,w,d,0);		else		{	s++;			s=gt_num(s,&e);			op_gen(x==1?EE:GE,w,d,e);		}		break;	case 'o':		found = 1;		s = gt_num(s, &w);		if(w==0) break;		op_gen(O, w, 0, 0);		break;	case 'l':		found=1;		s=gt_num(s,&w);		if(w==0) break;		op_gen(L,w,0,0);		break;	case 'a':		found=1;		skip(s);		if(*s>='0' && *s<='9')		{	s=gt_num(s,&w);			if(w==0) break;			op_gen(AW,w,0,0);			break;		}		op_gen(A,0,0,0);		break;	case 'f':		found=1;		s=gt_num(s,&w);		if(w==0) break;		if(*s=='.')		{	s++;			s=gt_num(s,&d);		}		else d=0;		op_gen(F,w,d,0);		break;	case 'd':		found=1;		s=gt_num(s,&w);		if(w==0) break;		if(*s=='.')		{	s++;			s=gt_num(s,&d);		}		else d=0;		op_gen(D,w,d,0);		break;	case 'i':		found=1;		s=gt_num(s,&w);		if(w==0) break;		if(*s!='.')		{	op_gen(I,w,0,0);			break;		}		s++;		s=gt_num(s,&d);		op_gen(IM,w,d,0);		break;	}	if(found==0)	{	pc--; /*unSTACK*/		*p=sv;		return(0);	}	*p=s;	return(1);}op_gen(a,b,c,d){	struct syl *p= &syl[pc];	if(pc>=SYLMX)	{	fprintf(stderr,"format too complicated:\n%s\n",			fmtbuf);		abort();	}	p->op=a;	p->p1=b;	p->p2=c;	p->p3=d;	return(pc++);}char *gt_num(s,n) char *s; int *n;{	int m=0,cnt=0;	char c;	for(c= *s;;c = *s)	{	if(c==' ')		{	s++;			continue;		}		if(c>'9' || c<'0') break;		m=10*m+c-'0';		cnt++;		s++;	}	if(cnt==0) *n=1;	else *n=m;	return(s);}#define STKSZ 10int cnt[STKSZ],ret[STKSZ],cp,rp;flag workdone;en_fio(){	ftnint one=1;	return(do_fio(&one,NULL,0l));}do_fio(number,ptr,len) ftnint *number; ftnlen len; char *ptr;{	struct syl *p;	int n,i;	for(i=0;i<*number;i++,ptr+=len)	{loop:	switch(type_f((p= &syl[pc])->op))	{	default:		fprintf(stderr,"unknown code in do_fio: %d\n%s\n",			p->op,fmtbuf);		err(elist->cierr,100,"do_fio");	case NED:		if((*doned)(p,ptr))		{	pc++;			goto loop;		}		pc++;		continue;	case ED:		if(cnt[cp]<=0)		{	cp--;			pc++;			goto loop;		}		if(ptr==NULL)			return((*doend)());		cnt[cp]--;		workdone=1;		if((n=(*doed)(p,ptr,len))>0) err(elist->cierr,errno,"fmt");		if(n<0) err(elist->ciend,(EOF),"fmt");		continue;	case STACK:		cnt[++cp]=p->p1;		pc++;		goto loop;	case RET:		ret[++rp]=p->p1;		pc++;		goto loop;	case GOTO:		if(--cnt[cp]<=0)		{	cp--;			rp--;			pc++;			goto loop;		}		pc=1+ret[rp--];		goto loop;	case REVERT:		rp=cp=0;		pc = p->p1;		if(ptr==NULL)			return((*doend)());		if(!workdone) return(0);		if((n=(*dorevert)()) != 0) return(n);		goto loop;	case COLON:		if(ptr==NULL)			return((*doend)());		pc++;		goto loop;	case S:	case SS:		cplus=0;		pc++;		goto loop;	case SP:		cplus = 1;		pc++;		goto loop;	case P:	scale=p->p1;		pc++;		goto loop;	case BN:		cblank=0;		pc++;		goto loop;	case BZ:		cblank=1;		pc++;		goto loop;	}	}	return(0);}fmt_bg(){	workdone=cp=rp=pc=cursor=0;	cnt[0]=ret[0]=0;}type_f(n){	switch(n)	{	default:		return(n);	case RET:		return(RET);	case REVERT: return(REVERT);	case GOTO: return(GOTO);	case STACK: return(STACK);	case X:	case SLASH:	case APOS: case H:	case T: case TL: case TR:		return(NED);	case F:	case I:	case IM:	case A: case AW:	case O:	case L:	case E: case EE: case D:	case G: case GE:		return(ED);	}}char *ap_end(s) char *s;{	char quote;	quote= *s++;	for(;*s;s++)	{	if(*s!=quote) continue;		if(*++s!=quote) return(s);	}	err(elist->cierr,100,"bad string");}