BSD 4 development
[unix-history] / usr / src / lib / libI77uc / lread.c
CommitLineData
648e85ce
BJ
1/*
2 * list directed read
3 */
4
5#include "fio.h"
6#include "lio.h"
7
8#define SP 1
9#define B 2
10#define AP 4
11#define EX 8
12#define D 16
13#define EIN 32
14#define isblnk(x) (ltab[x+1]&B)
15#define issep(x) (ltab[x+1]&SP)
16#define isapos(x) (ltab[x+1]&AP)
17#define isexp(x) (ltab[x+1]&EX)
18#define isdigit(x) (ltab[x+1]&D)
19#define endlinp(x) (ltab[x+1]&EIN)
20
21#define GETC(x) (x=(*getn)())
22
23char *lrd = "list read";
24char *lchar;
25double lx,ly;
26int ltype;
27int l_read(),t_getc(),ungetc();
28
29char ltab[128+1] =
30{ EIN, /* offset one for EOF */
31/* 0- 15 */ 0,0,AP,0,0,0,0,0,0,B,SP|B|EIN,0,0,0,0,0, /* ^B,TAB,NEWLINE */
32/* 16- 31 */ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
33/* 32- 47 */ SP|B,0,AP,0,0,0,0,AP,0,0,0,0,SP,0,0,EIN, /* space,",',comma,/ */
34/* 48- 63 */ D,D,D,D,D,D,D,D,D,D,0,0,0,0,0,0, /* digits 0-9 */
35/* 64- 79 */ 0,0,0,0,EX,EX,0,0,0,0,0,0,0,0,0,0, /* D,E */
36/* 80- 95 */ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
37/* 96-111 */ 0,0,0,0,EX,EX,0,0,0,0,0,0,0,0,0,0, /* d,e */
38/* 112-127 */ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
39};
40
41s_rsle(a) cilist *a; /* start read sequential list external */
42{
43 int n;
44 reading = YES;
45 if(n=c_le(a,READ)) return(n);
46 l_first = YES;
47 lquit = NO;
48 lioproc = l_read;
49 getn = t_getc;
50 ungetn = ungetc;
51 leof = curunit->uend;
52 lcount = 0;
53 if(curunit->uwrt) nowreading(curunit);
54 return(OK);
55}
56
57t_getc()
58{ int ch;
59 if(curunit->uend) return(EOF);
60 if((ch=getc(cf))!=EOF) return(ch);
61 if(feof(cf))
62 { curunit->uend = YES;
63 leof = EOF;
64 }
65 else clearerr(cf);
66 return(EOF);
67}
68
69e_rsle()
70{
71 int ch;
72 if(curunit->uend) return(OK);
73 while(!endlinp(GETC(ch)));
74 return(OK);
75}
76
77l_read(number,ptr,len,type) ftnint *number,type; flex *ptr; ftnlen len;
78{ int i,n,ch;
79 double *yy;
80 float *xx;
81 for(i=0;i<*number;i++)
82 {
83 if(leof) err(endflag, EOF, lrd)
84 if(l_first)
85 { l_first = NO;
86 while(isblnk(GETC(ch))); /* skip blanks */
87 (*ungetn)(ch,cf);
88 }
89 else if(lcount==0) /* repeat count == 0 ? */
90 { ERR(t_sep()); /* look for non-blank, allow 1 comma */
91 if(lquit) return(OK); /* slash found */
92 }
93 switch((int)type)
94 {
95 case TYSHORT:
96 case TYLONG:
97 case TYREAL:
98 case TYDREAL:
99 ERR(l_R(1));
100 break;
101 case TYCOMPLEX:
102 case TYDCOMPLEX:
103 ERR(l_C());
104 break;
105 case TYLOGICAL:
106 ERR(l_L());
107 break;
108 case TYCHAR:
109 ERR(l_CHAR());
110 break;
111 }
112 if(lquit) return(OK);
113 if(leof) err(endflag,EOF,lrd)
114 else if(external && ferror(cf)) err(errflag,errno,lrd)
115 if(ltype) switch((int)type)
116 {
117 case TYSHORT:
118 ptr->flshort=lx;
119 break;
120 case TYLOGICAL:
121 case TYLONG:
122 ptr->flint=lx;
123 break;
124 case TYREAL:
125 ptr->flreal=lx;
126 break;
127 case TYDREAL:
128 ptr->fldouble=lx;
129 break;
130 case TYCOMPLEX:
131 xx=(float *)ptr;
132 *xx++ = ly;
133 *xx = lx;
134 break;
135 case TYDCOMPLEX:
136 yy=(double *)ptr;
137 *yy++ = ly;
138 *yy = lx;
139 break;
140 case TYCHAR:
141 b_char(lchar,(char *)ptr,len);
142 break;
143 }
144 if(lcount>0) lcount--;
145 ptr = (char *)ptr + len;
146 }
147 return(OK);
148}
149
150lr_comm()
151{ int ch;
152 if(lcount) return(lcount);
153 ltype=NULL;
154 while(isblnk(GETC(ch)));
155 if(ch==',')
156 { lcount=1;
157 return(lcount);
158 }
159 (*ungetn)(ch,cf);
160 if(ch=='/')
161 { lquit = YES;
162 return(lquit);
163 }
164 else
165 return(OK);
166}
167
168get_repet()
169{ char ch;
170 double lc;
171 if(isdigit(GETC(ch)))
172 { (*ungetn)(ch,cf);
173 rd_int(&lc);
174 lcount = (int)lc;
175 if(GETC(ch)!='*')
176 if(leof) return(EOF);
177 else return(109);
178 }
179 else
180 { lcount = 1;
181 (*ungetn)(ch,cf);
182 }
183 return(OK);
184}
185
186l_R(flg) int flg;
187{ double a,b,c,d;
188 int da,db,dc,dd;
189 int i,ch,sign=0;
190 a=b=c=d=0;
191 da=db=dc=dd=0;
192 if(flg && lr_comm()) return(OK);
193 da=rd_int(&a); /* repeat count ? */
194 if(GETC(ch)=='*')
195 {
196 if (a <= 0.) return(122);
197 lcount=(int)a;
198 db=rd_int(&b); /* whole part of number */
199 }
200 else
201 { (*ungetn)(ch,cf);
202 db=da;
203 b=a;
204 lcount=1;
205 }
206 if(GETC(ch)=='.' && isdigit(GETC(ch)))
207 { (*ungetn)(ch,cf);
208 dc=rd_int(&c); /* fractional part of number */
209 }
210 else
211 { (*ungetn)(ch,cf);
212 dc=0;
213 c=0.;
214 }
215 if(isexp(GETC(ch)))
216 dd=rd_int(&d); /* exponent */
217 else if (ch == '+' || ch == '-')
218 { (*ungetn)(ch,cf);
219 dd=rd_int(&d);
220 }
221 else
222 { (*ungetn)(ch,cf);
223 dd=0;
224 }
225 if(db<0 || b<0)
226 { sign=1;
227 b = -b;
228 }
229 for(i=0;i<dc;i++) c/=10.;
230 b=b+c;
231 if (dd > 0)
232 { for(i=0;i<d;i++) b *= 10.;
233 for(i=0;i< -d;i++) b /= 10.;
234 }
235 lx=sign?-b:b;
236 ltype=TYLONG;
237 return(OK);
238}
239
240rd_int(x) double *x;
241{ int ch,sign=0,i=0;
242 double y=0.0;
243 if(GETC(ch)=='-') sign = -1;
244 else if(ch=='+') sign=0;
245 else (*ungetn)(ch,cf);
246 while(isdigit(GETC(ch)))
247 { i++;
248 y=10*y + ch-'0';
249 }
250 (*ungetn)(ch,cf);
251 if(sign) y = -y;
252 *x = y;
253 return(y==0.0?sign:i); /* 0:[+]&&y==0, -1:-&&y==0, >0:#digits&&y!=0 */
254}
255
256l_C()
257{ int ch,n;
258 if(lr_comm()) return(OK);
259 if(n=get_repet()) return(n); /* get repeat count */
260 if(GETC(ch)!='(') err(errflag,112,"no (")
261 while(isblnk(GETC(ch)));
262 (*ungetn)(ch,cf);
263 l_R(0); /* get real part */
264 ly = lx;
265 if(t_sep()) return(EOF);
266 l_R(0); /* get imag part */
267 while(isblnk(GETC(ch)));
268 if(ch!=')') err(errflag,112,"no )")
269 ltype = TYCOMPLEX;
270 return(OK);
271}
272
273l_L()
274{
275 int ch,n;
276 if(lr_comm()) return(OK);
277 if(n=get_repet()) return(n); /* get repeat count */
278 if(GETC(ch)=='.') GETC(ch);
279 switch(ch)
280 {
281 case 't':
282 case 'T':
283 lx=1;
284 break;
285 case 'f':
286 case 'F':
287 lx=0;
288 break;
289 default:
290 if(isblnk(ch) || issep(ch))
291 { (*ungetn)(ch,cf);
292 lx=0;
293 return(OK);
294 }
295 else if(ch==EOF) return(EOF);
296 else err(errflag,112,"logical not T or F");
297 }
298 ltype=TYLOGICAL;
299 while(!issep(GETC(ch)) && !isblnk(ch) && ch!='\n' && ch!=EOF);
300 return(OK);
301}
302
303#define BUFSIZE 128
304l_CHAR()
305{ int ch,size,i,n;
306 char quote,*p;
307 if(lr_comm()) return(OK);
308 if(n=get_repet()) return(n); /* get repeat count */
309 if(isapos(GETC(ch))) quote=ch;
310 else if(isblnk(ch) || issep(ch) || ch==EOF || ch=='\n')
311 { if(ch==EOF) return(EOF);
312 (*ungetn)(ch,cf);
313 return(OK);
314 }
315 else
316 { quote = '\0'; /* to allow single word non-quoted */
317 (*ungetn)(ch,cf);
318 }
319 ltype=TYCHAR;
320 if(lchar!=NULL) free(lchar);
321 size=BUFSIZE-1;
322 p=lchar=(char *)malloc(BUFSIZE);
323 if(lchar==NULL) err(errflag,113,lrd)
324 for(i=0;;)
325 { while( ( (quote && GETC(ch)!=quote) ||
326 (!quote && !issep(GETC(ch)) && !isblnk(ch) ) )
327 && ch!='\n' && ch!=EOF && ++i<size )
328 *p++ = ch;
329 if(i==size)
330 {
331 newone:
332 size += BUFSIZE;
333 lchar=(char *)realloc(lchar, size+1);
334 if(lchar==NULL) err(errflag,113,lrd)
335 p=lchar+i-1;
336 *p++ = ch;
337 }
338 else if(ch==EOF) return(EOF);
339 else if(ch=='\n')
340 { if(*(p-1) == '\\') *(p-1) = ch;
341 else if(!quote)
342 { *p = '\0';
343 (*ungetn)(ch,cf);
344 return(OK);
345 }
346 }
347 else if(quote && GETC(ch)==quote)
348 { if(++i<size) *p++ = ch;
349 else goto newone;
350 }
351 else
352 { (*ungetn)(ch,cf);
353 *p = '\0';
354 return(OK);
355 }
356 }
357}
358
359t_sep()
360{
361 int ch;
362 while(isblnk(GETC(ch)));
363 if(leof) return(EOF);
364 if(ch=='/')
365 { lquit = YES;
366 (*ungetn)(ch,cf);
367 return(OK);
368 }
369 if(issep(ch)) while(isblnk(GETC(ch)));
370 if(leof) return(EOF);
371 (*ungetn)(ch,cf);
372 return(OK);
373}