BSD 4 development
[unix-history] / usr / src / lib / libI77uc / rdfmt.c
CommitLineData
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
11rd_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
49rd_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
80rd_mvcur()
81{ int n;
82 if(tab) return((*dotab)());
83 while(cursor--) if((n=(*getn)()) < 0) return(n);
84 return(cursor=0);
85}
86
87rd_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 }
120done:
121 if(sign) x = -x;
122 if(len==sizeof(short)) n->is=x;
123 else n->il=x;
124 return(OK);
125}
126
127rd_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
140rd_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
210rd_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*/