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