Commit | Line | Data |
---|---|---|
55162a5a BJ |
1 | /* |
2 | * formatted read routines | |
3 | */ | |
4 | ||
5 | #include "fio.h" | |
6 | #include "fmt.h" | |
7 | ||
8 | #define isdigit(c) (c>='0' && c<='9') | |
9 | #define isalpha(c) (c>='a' && c<='z') | |
10 | ||
11 | rd_ed(p,ptr,len) char *ptr; struct syl *p; ftnlen len; | |
12 | { int n; | |
13 | if(cursor && (n=rd_mvcur())) return(n); | |
14 | switch(p->op) | |
15 | { | |
16 | case I: | |
17 | case IM: | |
18 | n = (rd_I(ptr,p->p1,len)); | |
19 | break; | |
20 | case L: | |
21 | n = (rd_L(ptr,p->p1)); | |
22 | break; | |
23 | case A: | |
24 | p->p1 = len; /* cheap trick */ | |
25 | case AW: | |
26 | n = (rd_AW(ptr,p->p1,len)); | |
27 | break; | |
28 | case E: | |
29 | case EE: | |
30 | case D: | |
31 | case DE: | |
32 | case G: | |
33 | case GE: | |
34 | case F: | |
35 | n = (rd_F(ptr,p->p1,p->p2,len)); | |
36 | break; | |
37 | default: | |
38 | return(errno=100); | |
39 | } | |
40 | if (n < 0) | |
41 | { | |
42 | if(feof(cf)) return(EOF); | |
43 | n = errno; | |
44 | clearerr(cf); | |
45 | } | |
46 | return(n); | |
47 | } | |
48 | ||
49 | rd_ned(p,ptr) char *ptr; struct syl *p; | |
50 | { | |
51 | switch(p->op) | |
52 | { | |
53 | /* case APOS: | |
54 | /* return(rd_POS(p->p1)); | |
55 | /* case H: | |
56 | /* return(rd_H(p->p1,p->p2)); */ | |
57 | case SLASH: | |
58 | return((*donewrec)()); | |
59 | case TR: | |
60 | case X: | |
61 | cursor += p->p1; | |
62 | tab = (p->op==TR); | |
63 | return(OK); | |
64 | case T: | |
65 | if(p->p1) cursor = p->p1 - recpos - 1; | |
66 | #ifndef KOSHER | |
67 | else cursor = 8*p->p2 - recpos%8; /* NOT STANDARD FORT */ | |
68 | #endif | |
69 | tab = YES; | |
70 | return(OK); | |
71 | case TL: | |
72 | cursor -= p->p1; | |
73 | tab = YES; | |
74 | return(OK); | |
75 | default: | |
76 | return(errno=100); | |
77 | } | |
78 | } | |
79 | ||
80 | rd_mvcur() | |
81 | { int n; | |
82 | if(tab) return((*dotab)()); | |
83 | while(cursor--) if((n=(*getn)()) < 0) return(n); | |
84 | return(cursor=0); | |
85 | } | |
86 | ||
87 | rd_I(n,w,len) ftnlen len; uint *n; | |
88 | { long x=0; | |
89 | int i,sign=0,ch,c; | |
90 | for(i=0;i<w;i++) | |
91 | { | |
92 | if((ch=(*getn)())<0) return(ch); | |
93 | switch(ch=lcase(ch)) | |
94 | { | |
95 | case ',': goto done; | |
96 | case '+': break; | |
97 | case '-': | |
98 | sign=1; | |
99 | break; | |
100 | case ' ': | |
101 | if(cblank) x *= radix; | |
102 | break; | |
103 | case '\n': goto done; | |
104 | default: | |
105 | if(isdigit(ch)) | |
106 | { if ((c=(ch-'0')) < radix) | |
107 | { x = (x * radix) + c; | |
108 | break; | |
109 | } | |
110 | } | |
111 | else if(isalpha(ch)) | |
112 | { if ((c=(ch-'a'+10)) < radix) | |
113 | { x = (x * radix) + c; | |
114 | break; | |
115 | } | |
116 | } | |
117 | return(errno=115); | |
118 | } | |
119 | } | |
120 | done: | |
121 | if(sign) x = -x; | |
122 | if(len==sizeof(short)) n->is=x; | |
123 | else n->il=x; | |
124 | return(OK); | |
125 | } | |
126 | ||
127 | rd_L(n,w) ftnint *n; | |
128 | { int ch,i,v = -1; | |
129 | for(i=0;i<w;i++) | |
130 | { if((ch=(*getn)()) < 0) return(ch); | |
131 | if((ch=lcase(ch))=='t' && v==-1) v=1; | |
132 | else if(ch=='f' && v==-1) v=0; | |
133 | else if(ch==',') break; | |
134 | } | |
135 | if(v==-1) return(errno=116); | |
136 | *n=v; | |
137 | return(OK); | |
138 | } | |
139 | ||
140 | rd_F(p,w,d,len) ftnlen len; ufloat *p; | |
141 | { double x,y; | |
142 | int i,sx,sz,ch,dot,ny,z,sawz; | |
143 | x=y=0; | |
144 | sawz=z=ny=dot=sx=sz=0; | |
145 | for(i=0;i<w;) | |
146 | { i++; | |
147 | if((ch=(*getn)())<0) return(ch); | |
148 | ch=lcase(ch); | |
149 | if(ch==' ' && !cblank || ch=='+') continue; | |
150 | else if(ch=='-') sx=1; | |
151 | else if(ch<='9' && ch>='0') | |
152 | x=10*x+ch-'0'; | |
153 | else if(ch=='e' || ch=='d' || ch=='.') | |
154 | break; | |
155 | else if(cblank && ch==' ') x*=10; | |
156 | else if(ch==',') | |
157 | { i=w; | |
158 | break; | |
159 | } | |
160 | else if(ch!='\n') return(errno=115); | |
161 | } | |
162 | if(ch=='.') dot=1; | |
163 | while(i<w && ch!='e' && ch!='d' && ch!='+' && ch!='-') | |
164 | { i++; | |
165 | if((ch=(*getn)())<0) return(ch); | |
166 | ch = lcase(ch); | |
167 | if(ch<='9' && ch>='0') | |
168 | y=10*y+ch-'0'; | |
169 | else if(cblank && ch==' ') | |
170 | y *= 10; | |
171 | else if(ch==',') {i=w; break;} | |
172 | else if(ch==' ') continue; | |
173 | else continue; | |
174 | ny++; | |
175 | } | |
176 | if(ch=='-') sz=1; | |
177 | while(i<w) | |
178 | { i++; | |
179 | sawz=1; | |
180 | if((ch=(*getn)())<0) return(ch); | |
181 | ch = lcase(ch); | |
182 | if(ch=='-') sz=1; | |
183 | else if(ch<='9' && ch>='0') | |
184 | z=10*z+ch-'0'; | |
185 | else if(cblank && ch==' ') | |
186 | z *= 10; | |
187 | else if(ch==',') break; | |
188 | else if(ch==' ') continue; | |
189 | else if(ch=='+') continue; | |
190 | else if(ch!='\n') return(errno=115); | |
191 | } | |
192 | if(!dot) | |
193 | for(i=0;i<d;i++) x /= 10; | |
194 | for(i=0;i<ny;i++) y /= 10; | |
195 | x=x+y; | |
196 | if(sz) | |
197 | for(i=0;i<z;i++) x /=10; | |
198 | else for(i=0;i<z;i++) x *= 10; | |
199 | if(sx) x = -x; | |
200 | if(!sawz) | |
201 | { | |
202 | for(i=scale;i>0;i--) x /= 10; | |
203 | for(i=scale;i<0;i++) x *= 10; | |
204 | } | |
205 | if(len==sizeof(float)) p->pf=x; | |
206 | else p->pd=x; | |
207 | return(OK); | |
208 | } | |
209 | ||
210 | rd_AW(p,w,len) char *p; ftnlen len; | |
211 | { int i,ch; | |
212 | if(w >= len) | |
213 | { | |
214 | for(i=0;i<w-len;i++) GET(ch); | |
215 | for(i=0;i<len;i++) | |
216 | { GET(ch); | |
217 | *p++=VAL(ch); | |
218 | } | |
219 | } | |
220 | else | |
221 | { | |
222 | for(i=0;i<w;i++) | |
223 | { GET(ch); | |
224 | *p++=VAL(ch); | |
225 | } | |
226 | for(i=0;i<len-w;i++) *p++=' '; | |
227 | } | |
228 | return(OK); | |
229 | } | |
230 | ||
231 | /* THIS IS NOT ALLOWED IN THE NEW STANDARD 'CAUSE IT'S WEIRD */ | |
232 | /*rd_H(n,s) char *s; | |
233 | /*{ int i,ch; | |
234 | /* for(i=0;i<n;i++) | |
235 | /* if((ch=(*getn)())<0) return(ch); | |
236 | /* else if(ch=='\n') for(;i<n;i++) *s++ = ' '; | |
237 | /* else *s++ = ch; | |
238 | /* return(OK); | |
239 | /*} | |
240 | */ | |
241 | /*rd_POS(s) char *s; | |
242 | /*{ char quote; | |
243 | /* int ch; | |
244 | /* quote= *s++; | |
245 | /* for(;*s;s++) | |
246 | /* if(*s==quote && *(s+1)!=quote) break; | |
247 | /* else if((ch=(*getn)())<0) return(ch); | |
248 | /* else *s = ch=='\n'?' ':ch; | |
249 | /* return(OK); | |
250 | /*} | |
251 | */ |