# 1 "rdfmt.c"
static char rcsid[] = "$Header:rdfinc.c 12.0$";







# 1 "./fio.h"
static char rcsidfio [] = "$Header:rdfinc.c 12.0$";







# 1 "./fiodefs.h"
static char rcsidfiodefs [] = "$Header:rdfinc.c 12.0$";







# 1 "/usr/include/stdio.h"








# 11 "/usr/include/stdio.h"












extern	struct	_iobuf {
	int	_cnt;
	char	*_ptr;		
	char	*_base;		
	int	_bufsiz;
	short	_flag;
	char	_file;		
} _iob[];




































struct _iobuf	*fopen();
struct _iobuf	*fdopen();
struct _iobuf	*freopen();
struct _iobuf	*popen();
long	ftell();
char	*fgets();
char	*gets();
# 76 "/usr/include/stdio.h"


# 9 "./fiodefs.h"

# 1 "./f_errno.h"








# 1 "/usr/include/errno.h"









# 12 "/usr/include/errno.h"


























































	













	













	
















# 119 "/usr/include/errno.h"

# 9 "./f_errno.h"

extern int errno;
extern int f_nerr;





























# 10 "./fiodefs.h"




























typedef char ioflag;
typedef long ftnint;
typedef ftnint flag;
typedef long ftnlen;

typedef struct		
{	flag cierr;
	ftnint ciunit;
	flag ciend;
	char *cifmt;
	ftnint cirec;
} cilist;

typedef struct		
{	flag icierr;
	char *iciunit;
	flag iciend;
	char *icifmt;
	ftnint icirlen;
	ftnint icirnum;
	ftnint icirec;
} icilist;

typedef struct		
{	flag oerr;
	ftnint ounit;
	char *ofnm;
	ftnlen ofnmlen;
	char *osta;
	char *oacc;
	char *ofm;
	ftnint orl;
	char *oblnk;
} olist;

typedef struct		
{	flag cerr;
	ftnint cunit;
	char *csta;
} cllist;

typedef struct		
{	flag aerr;
	ftnint aunit;
} alist;

typedef struct		
{	struct _iobuf *ufd;	
	char *ufnm;
	long uinode;
	int url;	
	flag useek;	
	flag ufmt;
	flag uprnt;
	flag ublnk;
	flag uend;
	flag uwrt;	
	flag uscrtch;
} unit;

typedef struct		
{	flag inerr;
	ftnint inunit;
	char *infile;
	ftnlen infilen;
	ftnint	*inex;	
	ftnint	*inopen;
	ftnint	*innum;
	ftnint	*innamed;
	char	*inname;
	ftnlen	innamlen;
	char	*inacc;
	ftnlen	inacclen;
	char	*inseq;
	ftnlen	inseqlen;
	char 	*indir;
	ftnlen	indirlen;
	char	*inform;
	ftnlen	informlen;
	char	*infmt;
	ftnint	infmtlen;
	char	*inunf;
	ftnlen	inunflen;
	ftnint	*inrecl;
	ftnint	*innrec;
	char	*inblank;
	ftnlen	inblanklen;
} inlist;

typedef union
{	float pf;
	double pd;
} ufloat;

typedef union
{	short is;
	char ic;
	long il;
} uint;

struct ioiflg {
	short if_oeof;
	short if_ctrl;
	short if_bzro;
};



# 9 "./fio.h"










long ftell();

extern int errno;
extern ioflag init;
extern icilist *svic;	
extern flag reading,external,sequential,formatted;
extern int (*getn)(),(*putn)(),(*ungetn)();	
extern struct _iobuf *cf;	
extern unit *curunit;	
extern int lunit;	
extern char *lfname;	
extern unit units[];	
extern int recpos;		
extern ftnint recnum;		
extern int reclen;		
extern int (*doed)(), (*doned)();
extern int (*dorevert)(), (*donewrec)(), (*doend)(), (*dotab)();
extern ioflag cblank, cplus, tab, elist, signit, errflag, endflag;
extern char *fmtbuf, *icptr, *icend, *fmtptr;
extern int scale;
extern int cursor;
extern int radix;
extern struct ioiflg	ioiflg_;
# 9 "rdfmt.c"

# 1 "./format.h"
static char rcsidformat [] = "$Header:rdfinc.c 12.0$";






struct syl
{
	int op,p1,p2,p3;
};








































extern struct syl syl[];
extern int pc,parenlvl,revloc;

# 10 "rdfmt.c"




rd_ed(p,ptr,len) char *ptr; struct syl *p; ftnlen len;
{	int n;
	if(cursor && (n=rd_mvcur())) return(n);
	switch(p->op)
	{
	case 	7:
	case 	10:
		n = (rd_I(ptr,p->p1,len));
		break;
	case 	30:
		n = (rd_L(ptr,p->p1));
		break;
	case 	31:
		p->p1 = len;	
	case 32:
		n = (rd_AW(ptr,p->p1,len));
		break;
	case 	24:
	case 	25:
	case 	26:
	case 27		:
	case 	28:
	case 	29:
	case 	23:
		n = (rd_F(ptr,p->p1,p->p2,len));
		break;
	default:
		return(errno=	100	);
	}
	if (n < 0)
	{
		if(		(((cf)->_flag&020)!=0)) return((-1));
		n = errno;
			((cf)->_flag &= ~(040|020));
	}
	return(n);
}

rd_ned(p,ptr) char *ptr; struct syl *p;
{
	switch(p->op)
	{

	case 	11:					
		return(rd_POS((char *)p->p1));
	case 	12:						
		return(rd_H(p->p1,(char *)p->p2));

	case 	5:
		return((*donewrec)());
	case 	14:
	case 	4:
		cursor += p->p1;
		
		tab = 1;
		return(0);
	case 	15:
		if(p->p1) cursor = p->p1 - recpos - 1;

		else cursor = 8*p->p2 - recpos%8;	

		tab = 1;
		return(0);
	case 	13:
		cursor -= p->p1;
		if ((recpos + cursor) < 0) cursor = -recpos;	
		tab = 1;
		return(0);
	default:
		return(errno=	100	);
	}
}

rd_mvcur()
{	int n;
	if(tab) return((*dotab)());
	if (cursor < 0) return(errno=120	);
	while(cursor--) if((n=(*getn)()) < 0) return(n);
	return(cursor=0);
}

rd_I(n,w,len) ftnlen len; uint *n;
{	long x=0;
	int i,sign=0,ch,c;
	for(i=0;i<w;i++)
	{
		if((ch=(*getn)())<0) return(ch);
		switch(ch=	((ch >= 'A') && (ch <= 'Z') ? ch+('a'-'A') : ch))
		{
		case ',': goto done;
		case '+': break;
		case '-':
			sign=1;
			break;
		case ' ':
			if(cblank) x *= radix;
			break;
		case '\n':  goto done;
		default:
			if(	(ch>='0' && ch<='9'))
			{	if ((c=(ch-'0')) < radix)
				{	x = (x * radix) + c;
					break;
				}
			}
			else if(	(ch>='a' && ch<='z'))
			{	if ((c=(ch-'a'+10)) < radix)
				{	x = (x * radix) + c;
					break;
				}
			}
			return(errno=115	);
		}
	}
done:
	if(sign) x = -x;
	if(len==sizeof(short)) n->is=x;
	else n->il=x;
	return(0);
}

rd_L(n,w) ftnint *n;
{	int ch,i,v = -1;
	for(i=0;i<w;i++)
	{	if((ch=(*getn)()) < 0) return(ch);
		if((ch=	((ch >= 'A') && (ch <= 'Z') ? ch+('a'-'A') : ch))=='t' && v==-1) v=1;
		else if(ch=='f' && v==-1) v=0;
		else if(ch==',') break;
	}
	if(v==-1) return(errno=116	);
	*n=v;
	return(0);
}

rd_F(p,w,d,len) ftnlen len; ufloat *p;
{	double x,y;
	int i,sx,sz,ch,dot,ny,z,sawz;
	x=y=0;
	sawz=z=ny=dot=sx=sz=0;
	for(i=0;i<w;)
	{	i++;
		if((ch=(*getn)())<0) return(ch);
		ch=	((ch >= 'A') && (ch <= 'Z') ? ch+('a'-'A') : ch);
		if(ch==' ' && !cblank || ch=='+') continue;
		else if(ch=='-') sx=1;
		else if(ch<='9' && ch>='0')
			x=10*x+ch-'0';
		else if(ch=='e' || ch=='d' || ch=='.')
			break;
		else if(cblank && ch==' ') x*=10;
		else if(ch==',')
		{	i=w;
			break;
		}
		else if(ch!='\n') return(errno=115	);
	}
	if(ch=='.') dot=1;
	while(i<w && ch!='e' && ch!='d' && ch!='+' && ch!='-')
	{	i++;
		if((ch=(*getn)())<0) return(ch);
		ch = 	((ch >= 'A') && (ch <= 'Z') ? ch+('a'-'A') : ch);
		if(ch<='9' && ch>='0')
			y=10*y+ch-'0';
		else if(cblank && ch==' ')
			y *= 10;
		else if(ch==',') {i=w; break;}
		else if(ch==' ') continue;
		else continue;
		ny++;
	}
	if(ch=='-') sz=1;
	while(i<w)
	{	i++;
		sawz=1;
		if((ch=(*getn)())<0) return(ch);
		ch = 	((ch >= 'A') && (ch <= 'Z') ? ch+('a'-'A') : ch);
		if(ch=='-') sz=1;
		else if(ch<='9' && ch>='0')
			z=10*z+ch-'0';
		else if(cblank && ch==' ')
			z *= 10;
		else if(ch==',') break;
		else if(ch==' ') continue;
		else if(ch=='+') continue;
		else if(ch!='\n') return(errno=115	);
	}
	if(!dot)
		for(i=0;i<d;i++) x /= 10;
	for(i=0;i<ny;i++) y /= 10;
	x=x+y;
	if(sz)
		for(i=0;i<z;i++) x /=10;
	else	for(i=0;i<z;i++) x *= 10;
	if(sx) x = -x;
	if(!sawz)
	{
		for(i=scale;i>0;i--) x /= 10;
		for(i=scale;i<0;i++) x *= 10;
	}
	if(len==sizeof(float)) p->pf=x;
	else p->pd=x;
	return(0);
}

rd_AW(p,w,len) char *p; ftnlen len;
{	int i,ch;
	if(w >= len)
	{
		for(i=0;i<w-len;i++) 		if((ch=(*getn)())<0) return(ch);
		for(i=0;i<len;i++)
		{			if((ch=(*getn)())<0) return(ch);
			*p++=		(ch!='\n'?ch:' ');
		}
	}
	else
	{
		for(i=0;i<w;i++)
		{			if((ch=(*getn)())<0) return(ch);
			*p++=		(ch!='\n'?ch:' ');
		}
		for(i=0;i<len-w;i++) *p++=' ';
	}
	return(0);
}


rd_H(n,s) char *s;
{	int i,ch = 0;
	for(i=0;i<n;i++)
	{	if (ch != '\n')
					if((ch=(*getn)())<0) return(ch);
		if (ch == '\n')
			*s++ = ' ';
		else
			*s++ = ch;
	}
	return(0);
}

rd_POS(s) char *s;
{	char quote;
	int ch = 0;
	quote = *s++;
	while(*s)
	{	if(*s==quote && *(s+1)!=quote)
			break;
		if (ch != '\n')
					if((ch=(*getn)())<0) return(ch);
		if (ch == '\n')
			*s++ = ' ';
		else
			*s++ = ch;
	}
	return(0);
}
