xref: /csrg-svn/usr.bin/f77/libI77/c_iio.c (revision 21011)
120995Slibs /*
2*21011Slibs char id_c_iio[] = "@(#)c_iio.c	1.2";
320995Slibs  *
420995Slibs  * internal (character array) i/o: common portions
520995Slibs  */
620995Slibs 
720995Slibs #include "fio.h"
820995Slibs #include "lio.h"
920995Slibs 
1020995Slibs LOCAL icilist *svic;		/* active internal io list */
11*21011Slibs LOCAL lio_nl;
1220995Slibs 
1320995Slibs int z_wnew();
1420995Slibs 
1520995Slibs z_getc()
1620995Slibs {
17*21011Slibs 	if(formatted == LISTDIRECTED )
18*21011Slibs 	{
19*21011Slibs 		if( lio_nl == YES )
20*21011Slibs 		{
21*21011Slibs 			recnum++;
22*21011Slibs 			recpos = 0;
23*21011Slibs 		}
24*21011Slibs 		else if (recpos == svic->icirlen)
25*21011Slibs 		{
26*21011Slibs 			lio_nl = YES;
27*21011Slibs 			return('\n');
28*21011Slibs 		}
29*21011Slibs 		lio_nl = NO;
30*21011Slibs 	}
31*21011Slibs 
3220995Slibs 	if(icptr >= icend && !recpos)	/* new rec beyond eof */
3320995Slibs 	{	leof = EOF;
3420995Slibs 		return(EOF);
3520995Slibs 	}
3620995Slibs 	if(recpos++ < svic->icirlen) return(*icptr++);
3720995Slibs 	return(' ');
3820995Slibs }
3920995Slibs 
4020995Slibs z_putc(c) char c;
4120995Slibs {
4220995Slibs 	if(icptr < icend)
4320995Slibs 	{	if(c=='\n') return(z_wnew());
4420995Slibs 		if(recpos++ < svic->icirlen)
4520995Slibs 		{	*icptr++ = c;
4620995Slibs 			return(OK);
4720995Slibs 		}
4820995Slibs 		else err(errflag,F_EREREC,"iio")
4920995Slibs 	}
5020995Slibs 	leof = EOF;
5120995Slibs #ifndef KOSHER
5220995Slibs 	err(endflag,EOF,"iio")   /* NOT STANDARD, end-of-file on writes */
5320995Slibs #endif
5420995Slibs #ifdef KOSHER
5520995Slibs 	err(errflag,F_EREREC,"iio")
5620995Slibs #endif
5720995Slibs }
5820995Slibs 
5920995Slibs z_ungetc(ch,cf) char ch;
60*21011Slibs {
61*21011Slibs 	if( lio_nl == YES )
62*21011Slibs 	{
63*21011Slibs 		lio_nl = NO;
64*21011Slibs 		return(OK);
65*21011Slibs 	}
66*21011Slibs 	if(ch==EOF || --recpos >= svic->icirlen) return(OK);
6720995Slibs 	if(--icptr < svic->iciunit || recpos < 0) err(errflag,F_ERBREC,"ilio")
6820995Slibs 	*icptr = ch;
6920995Slibs 	return(OK);
7020995Slibs }
7120995Slibs 
7220995Slibs LOCAL
7320995Slibs c_fi(a) icilist *a;
7420995Slibs {
7520995Slibs 	fmtbuf=a->icifmt;
7620995Slibs 	formatted = FORMATTED;
7720995Slibs 	external = NO;
7820995Slibs 	cblank=cplus=NO;
7920995Slibs 	scale=cursor=0;
8020995Slibs 	radix = 10;
8120995Slibs 	signit = YES;
8220995Slibs 	elist = YES;
8320995Slibs 	svic = a;
8420995Slibs 	recpos=reclen=0;
8520995Slibs 	icend = a->iciunit + a->icirnum*a->icirlen;
8620995Slibs 	errflag = a->icierr;
8720995Slibs 	endflag = a->iciend;
8820995Slibs 	return(OK);
8920995Slibs }
9020995Slibs 
9120995Slibs c_si(a) icilist *a;
9220995Slibs {
9320995Slibs 	sequential = YES;
9420995Slibs 	recnum = 0;
9520995Slibs 	icptr = a->iciunit;
9620995Slibs 	return(c_fi(a));
9720995Slibs }
9820995Slibs 
9920995Slibs c_di(a) icilist *a;
10020995Slibs {
10120995Slibs 	sequential = NO;
10220995Slibs 	recnum = a->icirec - 1;
10320995Slibs 	icptr = a->iciunit + recnum*a->icirlen;
10420995Slibs 	return(c_fi(a));
10520995Slibs }
10620995Slibs 
10720995Slibs z_rnew()
10820995Slibs {
10920995Slibs 	icptr = svic->iciunit + (++recnum)*svic->icirlen;
11020995Slibs 	recpos = reclen = cursor = 0;
11120995Slibs 	return(OK);
11220995Slibs }
11320995Slibs 
11420995Slibs z_wnew()
11520995Slibs {
11620995Slibs 	if(reclen > recpos)
11720995Slibs 	{	icptr += (reclen - recpos);
11820995Slibs 		recpos = reclen;
11920995Slibs 	}
12020995Slibs 	while(recpos < svic->icirlen) (*putn)(' ');
12120995Slibs 	recpos = reclen = cursor = 0;
12220995Slibs 	recnum++;
12320995Slibs 	return(OK);
12420995Slibs }
12520995Slibs 
12620995Slibs z_tab()
12720995Slibs {	int n;
12820995Slibs 	if(reclen < recpos) reclen = recpos;
12920995Slibs 	if((recpos + cursor) < 0) cursor = -recpos;	/* to BOR */
13020995Slibs 	n = reclen - recpos;
13120995Slibs 	if(!reading && (cursor-n) > 0)
13220995Slibs 	{	icptr += n;
13320995Slibs 		recpos = reclen;
13420995Slibs 		cursor -= n;
13520995Slibs 		while(cursor--) if(n=(*putn)(' ')) return(n);
13620995Slibs 	}
13720995Slibs 	else
13820995Slibs 	{	icptr += cursor;
13920995Slibs 		recpos += cursor;
14020995Slibs 	}
14120995Slibs 	return(cursor=0);
14220995Slibs }
14320995Slibs 
14420995Slibs c_li(a) icilist *a;
14520995Slibs {
14620995Slibs 	fmtbuf="int list io";
14720995Slibs 	sequential = formatted = LISTDIRECTED;
14820995Slibs 	external = NO;
14920995Slibs 	elist = YES;
15020995Slibs 	svic = a;
15120995Slibs 	recnum = recpos = 0;
15220995Slibs 	cplus = cblank = NO;
153*21011Slibs 	lio_nl = NO;
15420995Slibs 	icptr = a->iciunit;
15520995Slibs 	icend = icptr + a->icirlen * a->icirnum;
15620995Slibs 	errflag = a->icierr;
15720995Slibs 	endflag = a->iciend;
15820995Slibs 	leof = NO;
15920995Slibs 	return(OK);
16020995Slibs }
16120995Slibs 
16220995Slibs ftnint
16320995Slibs iiorec_()
16420995Slibs {	return(recnum);	}
16520995Slibs 
16620995Slibs ftnint
16720995Slibs iiopos_()
16820995Slibs {	return(recpos);	}
169