1 /*-
2 * Copyright (c) 1980 The Regents of the University of California.
3 * All rights reserved.
4 *
5 * %sccs.include.proprietary.c%
6 */
7
8 #ifndef lint
9 static char sccsid[] = "@(#)rdfmt.c 5.2 (Berkeley) 04/12/91";
10 #endif /* not lint */
11
12 /*
13 * formatted read routines
14 */
15
16 #include "fio.h"
17 #include "format.h"
18
19 extern char *s_init;
20 extern int low_case[256];
21 extern int used_data;
22
rd_ed(p,ptr,len)23 rd_ed(p,ptr,len) char *ptr; struct syl *p; ftnlen len;
24 { int n;
25 if(cursor && (n=rd_mvcur())) return(n);
26 switch(p->op)
27 {
28 case I:
29 case IM:
30 n = (rd_I(ptr,p->p1,len));
31 break;
32 case L:
33 n = (rd_L(ptr,p->p1,len));
34 break;
35 case A:
36 n = (rd_AW(ptr,len,len));
37 break;
38 case AW:
39 n = (rd_AW(ptr,p->p1,len));
40 break;
41 case E:
42 case EE:
43 case D:
44 case DE:
45 case G:
46 case GE:
47 case F:
48 n = (rd_F(ptr,p->p1,p->p2,len));
49 break;
50 default:
51 return(errno=F_ERFMT);
52 }
53 if (n < 0)
54 {
55 if(feof(cf)) return(EOF);
56 n = errno;
57 clearerr(cf);
58 }
59 return(n);
60 }
61
rd_ned(p,ptr)62 rd_ned(p,ptr) char *ptr; struct syl *p;
63 {
64 switch(p->op)
65 {
66 #ifndef KOSHER
67 case APOS: /* NOT STANDARD F77 */
68 return(rd_POS(&s_init[p->p1]));
69 case H: /* NOT STANDARD F77 */
70 return(rd_H(p->p1,&s_init[p->p2]));
71 #endif
72 case SLASH:
73 return((*donewrec)());
74 case TR:
75 case X:
76 cursor += p->p1;
77 /* tab = (p->op==TR); This voids '..,tl6,1x,..' sequences */
78 tab = YES;
79 return(OK);
80 case T:
81 if(p->p1) cursor = p->p1 - recpos - 1;
82 #ifndef KOSHER
83 else cursor = 8*p->p2 - recpos%8; /* NOT STANDARD FORT */
84 #endif
85 tab = YES;
86 return(OK);
87 case TL:
88 cursor -= p->p1;
89 if ((recpos + cursor) < 0) cursor = -recpos; /* ANSI req'd */
90 tab = YES;
91 return(OK);
92 default:
93 return(errno=F_ERFMT);
94 }
95 }
96
97 LOCAL
rd_mvcur()98 rd_mvcur()
99 { int n;
100 if(tab) return((*dotab)());
101 if (cursor < 0) return(errno=F_ERSEEK);
102 while(cursor--) if((n=(*getn)()) < 0) return(n);
103 return(cursor=0);
104 }
105
106 LOCAL
rd_I(n,w,len)107 rd_I(n,w,len) ftnlen len; uint *n;
108 { long x=0;
109 int i,sign=0,ch,c,sign_ok=YES;
110 for(i=0;i<w;i++)
111 {
112 if((ch=(*getn)())<0) return(ch);
113 switch(ch)
114 {
115 case ',': goto done;
116 case '-': sign=1; /* and fall thru */
117 case '+': if(sign_ok == NO) return(errno=F_ERRICHR);
118 sign_ok = NO;
119 break;
120 case ' ':
121 if(cblank) x *= radix;
122 break;
123 case '\n': if(cblank) {
124 x *= radix;
125 break;
126 } else {
127 goto done;
128 }
129 default:
130 sign_ok = NO;
131 if( (c = ch-'0')>=0 && c<radix )
132 { x = (x * radix) + c;
133 break;
134 }
135 else if( (c = low_case[ch]-'a'+10)>=0 && c<radix )
136 { x = (x * radix) + c;
137 break;
138 }
139 return(errno=F_ERRICHR);
140 }
141 }
142 done:
143 if(sign) x = -x;
144 if(len==sizeof(short)) n->is=x;
145 else n->il=x;
146 return(OK);
147 }
148
149 LOCAL
rd_L(n,w,len)150 rd_L(n,w,len) uint *n; ftnlen len;
151 { int ch,i,v = -1, period=0;
152 for(i=0;i<w;i++)
153 { if((ch=(*getn)()) < 0) return(ch);
154 if((ch=low_case[ch])=='t' && v==-1) v=1;
155 else if(ch=='f' && v==-1) v=0;
156 else if(ch=='.' && !period) period++;
157 else if(ch==' ' || ch=='\t') ;
158 else if(ch==',') break;
159 else if(v==-1) return(errno=F_ERLOGIF);
160 }
161 if(v==-1) return(errno=F_ERLOGIF);
162 if(len==sizeof(short)) n->is=v;
163 else n->il=v;
164 return(OK);
165 }
166
167 LOCAL
rd_F(p,w,d,len)168 rd_F(p,w,d,len) ftnlen len; ufloat *p;
169 { double x,y;
170 int i,sx,sz,ch,dot,ny,z,sawz,mode, sign_ok=YES;
171 x=y=0;
172 sawz=z=ny=dot=sx=sz=0;
173 /* modes: 0 in initial blanks,
174 2 blanks plus sign
175 3 found a digit
176 */
177 mode = 0;
178
179 for(i=0;i<w;)
180 { i++;
181 if((ch=(*getn)())<0) return(ch);
182
183 if(ch==' ') { /* blank */
184 if(cblank && (mode==2)) x *= 10;
185 } else if(ch<='9' && ch>='0') { /* digit */
186 mode = 2;
187 x=10*x+ch-'0';
188 } else if(ch=='.') {
189 break;
190 } else if(ch=='e' || ch=='d' || ch=='E' || ch=='D') {
191 goto exponent;
192 } else if(ch=='+' || ch=='-') {
193 if(mode==0) { /* sign before digits */
194 if(ch=='-') sx=1;
195 mode = 1;
196 } else if(mode==1) { /* two signs before digits */
197 return(errno=F_ERRFCHR);
198 } else { /* sign after digits, weird but standard!
199 means exponent without 'e' or 'd' */
200 goto exponent;
201 }
202 } else if(ch==',') {
203 goto done;
204 } else if(ch=='\n') {
205 if(cblank && (mode==2)) x *= 10;
206 } else {
207 return(errno=F_ERRFCHR);
208 }
209 }
210 /* get here if out of characters to scan or found a period */
211 if(ch=='.') dot=1;
212 while(i<w)
213 { i++;
214 if((ch=(*getn)())<0) return(ch);
215
216 if(ch<='9' && ch>='0') {
217 y=10*y+ch-'0';
218 ny++;
219 } else if(ch==' ' || ch=='\n') {
220 if(cblank) {
221 y*= 10;
222 ny++;
223 }
224 } else if(ch==',') {
225 goto done;
226 } else if(ch=='d' || ch=='e' || ch=='+' || ch=='-' || ch=='D' || ch=='E') {
227 break;
228 } else {
229 return(errno=F_ERRFCHR);
230 }
231 }
232 /* now for the exponent.
233 * mode=3 means seen digit or sign of exponent.
234 * either out of characters to scan or
235 * ch is '+', '-', 'd', or 'e'.
236 */
237 exponent:
238 if(ch=='-' || ch=='+') {
239 if(ch=='-') sz=1;
240 mode = 3;
241 } else {
242 mode = 2;
243 }
244
245 while(i<w)
246 { i++;
247 sawz=1;
248 if((ch=(*getn)())<0) return(ch);
249
250 if(ch<='9' && ch>='0') {
251 mode = 3;
252 z=10*z+ch-'0';
253 } else if(ch=='+' || ch=='-') {
254 if(mode==3 ) return(errno=F_ERRFCHR);
255 mode = 3;
256 if(ch=='-') sz=1;
257 } else if(ch == ' ' || ch=='\n') {
258 if(cblank) z *=10;
259 } else if(ch==',') {
260 break;
261 } else {
262 return(errno=F_ERRFCHR);
263 }
264 }
265 done:
266 if(!dot)
267 for(i=0;i<d;i++) x /= 10;
268 for(i=0;i<ny;i++) y /= 10;
269 x=x+y;
270 if(sz)
271 for(i=0;i<z;i++) x /=10;
272 else for(i=0;i<z;i++) x *= 10;
273 if(sx) x = -x;
274 if(!sawz)
275 {
276 for(i=scale;i>0;i--) x /= 10;
277 for(i=scale;i<0;i++) x *= 10;
278 }
279 if(len==sizeof(float)) p->pf=x;
280 else p->pd=x;
281 return(OK);
282 }
283
284 LOCAL
rd_AW(p,w,len)285 rd_AW(p,w,len) char *p; ftnlen len;
286 { int i,ch;
287 if(w >= len)
288 {
289 for(i=0;i<w-len;i++) GET(ch);
290 for(i=0;i<len;i++)
291 { GET(ch);
292 *p++=VAL(ch);
293 }
294 }
295 else
296 {
297 for(i=0;i<w;i++)
298 { GET(ch);
299 *p++=VAL(ch);
300 }
301 for(i=0;i<len-w;i++) *p++=' ';
302 }
303 return(OK);
304 }
305
306 /* THIS IS NOT ALLOWED IN THE NEW STANDARD 'CAUSE IT'S WEIRD */
307 LOCAL
rd_H(n,s)308 rd_H(n,s) char *s;
309 { int i,ch = 0;
310
311 used_data = YES;
312 for(i=0;i<n;i++)
313 { if (ch != '\n')
314 GET(ch);
315 if (ch == '\n')
316 *s++ = ' ';
317 else
318 *s++ = ch;
319 }
320 return(OK);
321 }
322
323 LOCAL
rd_POS(s)324 rd_POS(s) char *s;
325 { char quote;
326 int ch = 0;
327
328 used_data = YES;
329 quote = *s++;
330 while(*s)
331 { if(*s==quote && *(s+1)!=quote)
332 break;
333 if (ch != '\n')
334 GET(ch);
335 if (ch == '\n')
336 *s++ = ' ';
337 else
338 *s++ = ch;
339 }
340 return(OK);
341 }
342