![[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] / 40BSD / lib / libI77uc|
Return to lread.c CVS log | Up to [CSRG BSD Unix] / 40BSD / lib / libI77uc |
1.1 root 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:
23: char *lrd = "list read";
24: char *lchar;
25: double lx,ly;
26: int ltype;
27: int l_read(),t_getc(),ungetc();
28:
29: char 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:
41: s_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:
57: t_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:
69: e_rsle()
70: {
71: int ch;
72: if(curunit->uend) return(OK);
73: while(!endlinp(GETC(ch)));
74: return(OK);
75: }
76:
77: l_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:
150: lr_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:
168: get_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:
186: l_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:
240: rd_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:
256: l_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:
273: l_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
304: l_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:
359: t_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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.