xref: /original-bsd/usr.bin/f77/libI77/sfe.c (revision a141c157)
1 /*
2 char id_sfe[] = "@(#)sfe.c	1.10";
3  *
4  * sequential formatted external routines
5  */
6 
7 #include "fio.h"
8 
9 /*
10  * read sequential formatted external
11  */
12 
13 extern int rd_ed(),rd_ned();
14 int x_rnew(),x_getc(),x_tab();
15 
16 LOCAL char rsfe[] = "read sfe";
17 LOCAL char wsfe[] = "write sfe";
18 
19 s_rsfe(a) cilist *a; /* start */
20 {	int n;
21 	reading = YES;
22 	if(n=c_sfe(a,READ)) return(n);
23 	if(curunit->uwrt && ! nowreading(curunit)) err(errflag, errno, rsfe)
24 	getn= x_getc;
25 	doed= rd_ed;
26 	doned= rd_ned;
27 	donewrec = dorevert = doend = x_rnew;
28 	dotab = x_tab;
29 	if(pars_f()) err(errflag,F_ERFMT,rsfe)
30 	fmt_bg();
31 	return(OK);
32 }
33 
34 LOCAL
35 x_rnew()			/* find next record */
36 {	int ch;
37 	if(curunit->uend)
38 		return(EOF);
39 	while((ch=getc(cf))!='\n' && ch!=EOF);
40 	if(feof(cf))
41 	{	curunit->uend = YES;
42 		if (recpos==0) return(EOF);
43 	}
44 	cursor=recpos=reclen=0;
45 	return(OK);
46 }
47 
48 LOCAL
49 x_getc()
50 {	int ch;
51 	if(curunit->uend) return(EOF);
52 	if((ch=getc(cf))!=EOF && ch!='\n')
53 	{	recpos++;
54 		return(ch);
55 	}
56 	if(ch=='\n')
57 	{	ungetc(ch,cf);
58 		return(ch);
59 	}
60 	if(feof(cf)) curunit->uend = YES;
61 	return(EOF);
62 }
63 
64 e_rsfe()
65 {	int n;
66 	n=en_fio();
67 	fmtbuf=NULL;
68 	return(n);
69 }
70 
71 LOCAL
72 c_sfe(a,flag) cilist *a; /* check */
73 {	unit *p;
74 	int n;
75 	external=sequential=formatted=FORMATTED;
76 	fmtbuf=a->cifmt;
77 	lfname = NULL;
78 	elist = NO;
79 	errflag = a->cierr;
80 	endflag = a->ciend;
81 	lunit = a->ciunit;
82 	if(not_legal(lunit)) err(errflag,F_ERUNIT,rsfe+5);
83 	curunit = p = &units[lunit];
84 	if(!p->ufd && (n=fk_open(flag,SEQ,FMT,(ftnint)lunit)) )
85 		err(errflag,n,rsfe+5)
86 	cf = curunit->ufd;
87 	elist = YES;
88 	lfname = curunit->ufnm;
89 	if(!p->ufmt) err(errflag,F_ERNOFIO,rsfe+5)
90 	if(p->url) err(errflag,F_ERNOSIO,rsfe+5)
91 	cursor=recpos=scale=reclen=0;
92 	radix = 10;
93 	signit = YES;
94 	cblank = curunit->ublnk;
95 	cplus = NO;
96 	return(OK);
97 }
98 
99 /*
100  * write sequential formatted external
101  */
102 
103 extern int w_ed(),w_ned();
104 int x_putc(),pr_put(),x_wend(),x_wnew();
105 LOCAL ioflag new;
106 
107 s_wsfe(a) cilist *a;	/*start*/
108 {	int n;
109 	reading = NO;
110 	if(n=c_sfe(a,WRITE)) return(n);
111 	if(!curunit->uwrt && ! nowwriting(curunit)) err(errflag, errno, wsfe)
112 	curunit->uend = NO;
113 	if (curunit->uprnt) putn = pr_put;
114 	else putn = x_putc;
115 	new = YES;
116 	doed= w_ed;
117 	doned= w_ned;
118 	doend = x_wend;
119 	dorevert = donewrec = x_wnew;
120 	dotab = x_tab;
121 	if(pars_f()) err(errflag,F_ERFMT,wsfe)
122 	fmt_bg();
123 	return(OK);
124 }
125 
126 LOCAL
127 x_putc(c)
128 {
129 	if(c=='\n') recpos = reclen = cursor = 0;
130 	else recpos++;
131 	if (c) putc(c,cf);
132 	return(OK);
133 }
134 
135 LOCAL
136 pr_put(c)
137 {
138 	if(c=='\n')
139 	{	new = YES;
140 		recpos = reclen = cursor = 0;
141 	}
142 	else if(new)
143 	{	new = NO;
144 		if(c=='0') c = '\n';
145 		else if(c=='1') c = '\f';
146 		else return(OK);
147 	}
148 	else recpos++;
149 	if (c) putc(c,cf);
150 	return(OK);
151 }
152 
153 LOCAL
154 x_tab()
155 {	int n;
156 	if(reclen < recpos) reclen = recpos;
157 	if(curunit->useek)
158 	{	if((recpos+cursor) < 0) cursor = -recpos;	/* to BOR */
159 		n = reclen - recpos;	/* distance to eor, n>=0 */
160 		if((cursor-n) > 0)
161 		{	fseek(cf,(long)n,1);  /* find current eor */
162 			recpos = reclen;
163 			cursor -= n;
164 		}
165 		else
166 		{	fseek(cf,(long)cursor,1);  /* do not pass go */
167 			recpos += cursor;
168 			return(cursor=0);
169 		}
170 	}
171 	else
172 		if(cursor < 0) return(F_ERSEEK);   /* can't go back */
173 	while(cursor--)
174 	{	if(reading)
175 		{	n = (*getn)();
176 			if(n=='\n') return(cursor=0);	/* be tolerant */
177 			if(n==EOF) return(EOF);
178 		}
179 		else	(*putn)(' ');	/* fill in the empty record */
180 	}
181 	return(cursor=0);
182 }
183 
184 LOCAL
185 x_wnew()
186 {
187 	if(reclen>recpos) fseek(cf,(long)(reclen-recpos),1);
188 	return((*putn)('\n'));
189 }
190 
191 LOCAL
192 x_wend(last) char last;
193 {
194 	if(reclen>recpos) fseek(cf,(long)(reclen-recpos),1);
195 	return((*putn)(last));
196 }
197 
198 /*
199 /*xw_rev()
200 /*{
201 /*	if(workdone) x_wSL();
202 /*	return(workdone=0);
203 /*}
204 /*
205 */
206 e_wsfe()
207 {	return(e_rsfe()); }
208