Commit | Line | Data |
---|---|---|
7a517deb TL |
1 | #include "fio.h" |
2 | #include "fmt.h" | |
3 | extern int cursor; | |
4 | rd_ed(p,ptr,len) char *ptr; struct syl *p; ftnlen len; | |
5 | { int ch; | |
6 | for(;cursor>0;cursor--) if((ch=(*getn)())<0) return(ch); | |
7 | if(cursor<0) | |
8 | { if(recpos+cursor < 0) err(elist->cierr,110,"fmt") | |
9 | if(curunit->useek) fseek(cf,(long) cursor,1); | |
10 | else err(elist->cierr,106,"fmt"); | |
11 | cursor=0; | |
12 | } | |
13 | switch(p->op) | |
14 | { | |
15 | default: fprintf(stderr,"rd_ed, unexpected code: %d\n%s\n", | |
16 | p->op,fmtbuf); | |
17 | abort(); | |
18 | case I: ch = (rd_I(ptr,p->p1,len)); | |
19 | break; | |
20 | case IM: ch = (rd_I(ptr,p->p1,len)); | |
21 | break; | |
22 | case L: ch = (rd_L(ptr,p->p1)); | |
23 | break; | |
24 | case A: ch = (rd_A(ptr,len)); | |
25 | break; | |
26 | case AW: | |
27 | ch = (rd_AW(ptr,p->p1,len)); | |
28 | break; | |
29 | case E: case EE: | |
30 | case D: | |
31 | case G: | |
32 | case GE: | |
33 | case F: ch = (rd_F(ptr,p->p1,p->p2,len)); | |
34 | break; | |
35 | } | |
36 | if(ch == 0) return(ch); | |
37 | else if(feof(cf)) return(EOF); | |
38 | clearerr(cf); | |
39 | return(errno); | |
40 | } | |
41 | rd_ned(p,ptr) char *ptr; struct syl *p; | |
42 | { | |
43 | switch(p->op) | |
44 | { | |
45 | default: fprintf(stderr,"rd_ned, unexpected code: %d\n%s\n", | |
46 | p->op,fmtbuf); | |
47 | abort(); | |
48 | case APOS: | |
49 | return(rd_POS(p->p1)); | |
50 | case H: return(rd_H(p->p1,p->p2)); | |
51 | case SLASH: return((*donewrec)()); | |
52 | case TR: | |
53 | case X: cursor += p->p1; | |
54 | return(1); | |
55 | case T: cursor=p->p1-recpos; | |
56 | return(1); | |
57 | case TL: cursor -= p->p1; | |
58 | return(1); | |
59 | } | |
60 | } | |
61 | rd_I(n,w,len) ftnlen len; uint *n; | |
62 | { long x=0; | |
63 | int i,sign=0,ch; | |
64 | for(i=0;i<w;i++) | |
65 | { | |
66 | if((ch=(*getn)())<0) return(ch); | |
67 | switch(ch) | |
68 | { | |
69 | default: | |
70 | return(errno=115); | |
71 | case ',': goto done; | |
72 | case '+': break; | |
73 | case '-': | |
74 | sign=1; | |
75 | break; | |
76 | case ' ': | |
77 | if(cblank) x *= 10; | |
78 | break; | |
79 | case '\n': break; | |
80 | case '0': case '1': case '2': case '3': case '4': | |
81 | case '5': case '6': case '7': case '8': case '9': | |
82 | x=10*x+ch-'0'; | |
83 | break; | |
84 | } | |
85 | } | |
86 | done: | |
87 | if(sign) x = -x; | |
88 | if(len==sizeof(short)) n->is=x; | |
89 | else n->il=x; | |
90 | return(0); | |
91 | } | |
92 | rd_L(n,w) ftnint *n; | |
93 | { int ch,i,v = -1; | |
94 | for(i=0;i<w;i++) | |
95 | { if((ch=(*getn)())<0) return(ch); | |
96 | if(ch=='t' && v==-1) v=1; | |
97 | else if(ch=='f' && v==-1) v=0; | |
98 | else if(ch==',') return(0); | |
99 | } | |
100 | if(v==-1) | |
101 | { errno=116; | |
102 | return(1); | |
103 | } | |
104 | *n=v; | |
105 | return(0); | |
106 | } | |
107 | rd_F(p,w,d,len) ftnlen len; ufloat *p; | |
108 | { double x,y; | |
109 | int i,sx,sz,ch,dot,ny,z,sawz; | |
110 | x=y=0; | |
111 | sawz=z=ny=dot=sx=sz=0; | |
112 | for(i=0;i<w;) | |
113 | { i++; | |
114 | if((ch=(*getn)())<0) return(ch); | |
115 | else if(ch==' ' && !cblank || ch=='+') continue; | |
116 | else if(ch=='-') sx=1; | |
117 | else if(ch<='9' && ch>='0') | |
118 | x=10*x+ch-'0'; | |
119 | else if(ch=='e' || ch=='d' || ch=='.') | |
120 | break; | |
121 | else if(cblank && ch==' ') x*=10; | |
122 | else if(ch==',') | |
123 | { i=w; | |
124 | break; | |
125 | } | |
126 | else if(ch!='\n') return(errno=115); | |
127 | } | |
128 | if(ch=='.') dot=1; | |
129 | while(i<w && ch!='e' && ch!='d' && ch!='+' && ch!='-') | |
130 | { i++; | |
131 | if((ch=(*getn)())<0) return(ch); | |
132 | else if(ch<='9' && ch>='0') | |
133 | y=10*y+ch-'0'; | |
134 | else if(cblank && ch==' ') | |
135 | y *= 10; | |
136 | else if(ch==',') {i=w; break;} | |
137 | else if(ch==' ') continue; | |
138 | else continue; | |
139 | ny++; | |
140 | } | |
141 | if(ch=='-') sz=1; | |
142 | while(i<w) | |
143 | { i++; | |
144 | sawz=1; | |
145 | if((ch=(*getn)())<0) return(ch); | |
146 | else if(ch=='-') sz=1; | |
147 | else if(ch<='9' && ch>='0') | |
148 | z=10*z+ch-'0'; | |
149 | else if(cblank && ch==' ') | |
150 | z *= 10; | |
151 | else if(ch==',') break; | |
152 | else if(ch==' ') continue; | |
153 | else if(ch=='+') continue; | |
154 | else if(ch!='\n') return(errno=115); | |
155 | } | |
156 | if(!dot) | |
157 | for(i=0;i<d;i++) x /= 10; | |
158 | for(i=0;i<ny;i++) y /= 10; | |
159 | x=x+y; | |
160 | if(sz) | |
161 | for(i=0;i<z;i++) x /=10; | |
162 | else for(i=0;i<z;i++) x *= 10; | |
163 | if(sx) x = -x; | |
164 | if(!sawz) | |
165 | { | |
166 | for(i=scale;i>0;i--) x /= 10; | |
167 | for(i=scale;i<0;i++) x *= 10; | |
168 | } | |
169 | if(len==sizeof(float)) p->pf=x; | |
170 | else p->pd=x; | |
171 | return(0); | |
172 | } | |
173 | rd_A(p,len) char *p; ftnlen len; | |
174 | { int i,ch; | |
175 | for(i=0;i<len;i++) | |
176 | { GET(ch); | |
177 | *p++=VAL(ch); | |
178 | } | |
179 | return(0); | |
180 | } | |
181 | rd_AW(p,w,len) char *p; ftnlen len; | |
182 | { int i,ch; | |
183 | if(w>=len) | |
184 | { for(i=0;i<w-len;i++) | |
185 | GET(ch); | |
186 | for(i=0;i<len;i++) | |
187 | { GET(ch); | |
188 | *p++=VAL(ch); | |
189 | } | |
190 | return(0); | |
191 | } | |
192 | for(i=0;i<w;i++) | |
193 | { GET(ch); | |
194 | *p++=VAL(ch); | |
195 | } | |
196 | for(i=0;i<len-w;i++) *p++=' '; | |
197 | return(0); | |
198 | } | |
199 | rd_H(n,s) char *s; | |
200 | { int i,ch; | |
201 | for(i=0;i<n;i++) | |
202 | if((ch=(*getn)())<0) return(ch); | |
203 | else if(ch=='\n') *s++ = ' '; | |
204 | else *s++ = ch=='\n'?' ':ch; | |
205 | return(1); | |
206 | } | |
207 | rd_POS(s) char *s; | |
208 | { char quote; | |
209 | int ch; | |
210 | quote= *s++; | |
211 | for(;*s;s++) | |
212 | if(*s==quote && *(s+1)!=quote) break; | |
213 | else if((ch=(*getn)())<0) return(ch); | |
214 | else *s = ch=='\n'?' ':ch; | |
215 | return(1); | |
216 | } |