xref: /csrg-svn/usr.bin/f77/libI77/c_iio.c (revision 24097)
120995Slibs /*
223065Skre  * Copyright (c) 1980 Regents of the University of California.
323065Skre  * All rights reserved.  The Berkeley software License Agreement
423065Skre  * specifies the terms and conditions for redistribution.
520995Slibs  *
6*24097Sjerry  *	@(#)c_iio.c	5.2	07/30/85
723065Skre  */
823065Skre 
923065Skre /*
1020995Slibs  * internal (character array) i/o: common portions
1120995Slibs  */
1220995Slibs 
1320995Slibs #include "fio.h"
1420995Slibs #include "lio.h"
1520995Slibs 
1620995Slibs LOCAL icilist *svic;		/* active internal io list */
1721011Slibs LOCAL lio_nl;
1820995Slibs 
1920995Slibs int z_wnew();
2020995Slibs 
2120995Slibs z_getc()
2220995Slibs {
2321011Slibs 	if(formatted == LISTDIRECTED )
2421011Slibs 	{
2521011Slibs 		if( lio_nl == YES )
2621011Slibs 		{
2721011Slibs 			recnum++;
2821011Slibs 			recpos = 0;
2921011Slibs 		}
3021011Slibs 		else if (recpos == svic->icirlen)
3121011Slibs 		{
3221011Slibs 			lio_nl = YES;
3321011Slibs 			return('\n');
3421011Slibs 		}
3521011Slibs 		lio_nl = NO;
3621011Slibs 	}
3721011Slibs 
3820995Slibs 	if(icptr >= icend && !recpos)	/* new rec beyond eof */
3920995Slibs 	{	leof = EOF;
4020995Slibs 		return(EOF);
4120995Slibs 	}
4220995Slibs 	if(recpos++ < svic->icirlen) return(*icptr++);
4320995Slibs 	return(' ');
4420995Slibs }
4520995Slibs 
4620995Slibs z_putc(c) char c;
4720995Slibs {
4820995Slibs 	if(icptr < icend)
4920995Slibs 	{	if(c=='\n') return(z_wnew());
5020995Slibs 		if(recpos++ < svic->icirlen)
5120995Slibs 		{	*icptr++ = c;
5220995Slibs 			return(OK);
5320995Slibs 		}
5420995Slibs 		else err(errflag,F_EREREC,"iio")
5520995Slibs 	}
5620995Slibs 	leof = EOF;
5720995Slibs #ifndef KOSHER
5820995Slibs 	err(endflag,EOF,"iio")   /* NOT STANDARD, end-of-file on writes */
5920995Slibs #endif
6020995Slibs #ifdef KOSHER
6120995Slibs 	err(errflag,F_EREREC,"iio")
6220995Slibs #endif
6320995Slibs }
6420995Slibs 
6520995Slibs z_ungetc(ch,cf) char ch;
6621011Slibs {
6721011Slibs 	if( lio_nl == YES )
6821011Slibs 	{
6921011Slibs 		lio_nl = NO;
7021011Slibs 		return(OK);
7121011Slibs 	}
7221011Slibs 	if(ch==EOF || --recpos >= svic->icirlen) return(OK);
7320995Slibs 	if(--icptr < svic->iciunit || recpos < 0) err(errflag,F_ERBREC,"ilio")
7420995Slibs 	*icptr = ch;
7520995Slibs 	return(OK);
7620995Slibs }
7720995Slibs 
7820995Slibs LOCAL
7920995Slibs c_fi(a) icilist *a;
8020995Slibs {
8120995Slibs 	fmtbuf=a->icifmt;
8220995Slibs 	formatted = FORMATTED;
8320995Slibs 	external = NO;
8420995Slibs 	cblank=cplus=NO;
8520995Slibs 	scale=cursor=0;
8620995Slibs 	radix = 10;
8720995Slibs 	signit = YES;
8820995Slibs 	elist = YES;
8920995Slibs 	svic = a;
9020995Slibs 	recpos=reclen=0;
9120995Slibs 	icend = a->iciunit + a->icirnum*a->icirlen;
9220995Slibs 	errflag = a->icierr;
9320995Slibs 	endflag = a->iciend;
9420995Slibs 	return(OK);
9520995Slibs }
9620995Slibs 
9720995Slibs c_si(a) icilist *a;
9820995Slibs {
9920995Slibs 	sequential = YES;
10020995Slibs 	recnum = 0;
10120995Slibs 	icptr = a->iciunit;
10220995Slibs 	return(c_fi(a));
10320995Slibs }
10420995Slibs 
10520995Slibs c_di(a) icilist *a;
10620995Slibs {
10720995Slibs 	sequential = NO;
10820995Slibs 	recnum = a->icirec - 1;
10920995Slibs 	icptr = a->iciunit + recnum*a->icirlen;
11020995Slibs 	return(c_fi(a));
11120995Slibs }
11220995Slibs 
11320995Slibs z_rnew()
11420995Slibs {
11520995Slibs 	icptr = svic->iciunit + (++recnum)*svic->icirlen;
11620995Slibs 	recpos = reclen = cursor = 0;
11720995Slibs 	return(OK);
11820995Slibs }
11920995Slibs 
12020995Slibs z_wnew()
12120995Slibs {
12220995Slibs 	if(reclen > recpos)
12320995Slibs 	{	icptr += (reclen - recpos);
12420995Slibs 		recpos = reclen;
12520995Slibs 	}
12620995Slibs 	while(recpos < svic->icirlen) (*putn)(' ');
12720995Slibs 	recpos = reclen = cursor = 0;
12820995Slibs 	recnum++;
12920995Slibs 	return(OK);
13020995Slibs }
13120995Slibs 
13220995Slibs z_tab()
13320995Slibs {	int n;
13420995Slibs 	if(reclen < recpos) reclen = recpos;
13520995Slibs 	if((recpos + cursor) < 0) cursor = -recpos;	/* to BOR */
13620995Slibs 	n = reclen - recpos;
13720995Slibs 	if(!reading && (cursor-n) > 0)
13820995Slibs 	{	icptr += n;
13920995Slibs 		recpos = reclen;
14020995Slibs 		cursor -= n;
14120995Slibs 		while(cursor--) if(n=(*putn)(' ')) return(n);
14220995Slibs 	}
14320995Slibs 	else
14420995Slibs 	{	icptr += cursor;
14520995Slibs 		recpos += cursor;
14620995Slibs 	}
14720995Slibs 	return(cursor=0);
14820995Slibs }
14920995Slibs 
15020995Slibs c_li(a) icilist *a;
15120995Slibs {
15220995Slibs 	fmtbuf="int list io";
153*24097Sjerry 	sequential = YES;
154*24097Sjerry 	formatted = LISTDIRECTED;
15520995Slibs 	external = NO;
15620995Slibs 	elist = YES;
15720995Slibs 	svic = a;
15820995Slibs 	recnum = recpos = 0;
15920995Slibs 	cplus = cblank = NO;
16021011Slibs 	lio_nl = NO;
16120995Slibs 	icptr = a->iciunit;
16220995Slibs 	icend = icptr + a->icirlen * a->icirnum;
16320995Slibs 	errflag = a->icierr;
16420995Slibs 	endflag = a->iciend;
16520995Slibs 	leof = NO;
16620995Slibs 	return(OK);
16720995Slibs }
168