![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to rdfmt.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / usr.lib / libI77|
Return to rdfmt.c CVS log | Up to [CSRG BSD Unix] / 43BSD / usr.lib / libI77 |
1.1 root 1: /*
2: * Copyright (c) 1980 Regents of the University of California.
3: * All rights reserved. The Berkeley software License Agreement
4: * specifies the terms and conditions for redistribution.
5: *
6: * @(#)rdfmt.c 5.1 6/7/85
7: */
8:
9: /*
10: * formatted read routines
11: */
12:
13: #include "fio.h"
14: #include "format.h"
15:
16: extern char *s_init;
17: extern int low_case[256];
18: extern int used_data;
19:
20: rd_ed(p,ptr,len) char *ptr; struct syl *p; ftnlen len;
21: { int n;
22: if(cursor && (n=rd_mvcur())) return(n);
23: switch(p->op)
24: {
25: case I:
26: case IM:
27: n = (rd_I(ptr,p->p1,len));
28: break;
29: case L:
30: n = (rd_L(ptr,p->p1,len));
31: break;
32: case A:
33: n = (rd_AW(ptr,len,len));
34: break;
35: case AW:
36: n = (rd_AW(ptr,p->p1,len));
37: break;
38: case E:
39: case EE:
40: case D:
41: case DE:
42: case G:
43: case GE:
44: case F:
45: n = (rd_F(ptr,p->p1,p->p2,len));
46: break;
47: default:
48: return(errno=F_ERFMT);
49: }
50: if (n < 0)
51: {
52: if(feof(cf)) return(EOF);
53: n = errno;
54: clearerr(cf);
55: }
56: return(n);
57: }
58:
59: rd_ned(p,ptr) char *ptr; struct syl *p;
60: {
61: switch(p->op)
62: {
63: #ifndef KOSHER
64: case APOS: /* NOT STANDARD F77 */
65: return(rd_POS(&s_init[p->p1]));
66: case H: /* NOT STANDARD F77 */
67: return(rd_H(p->p1,&s_init[p->p2]));
68: #endif
69: case SLASH:
70: return((*donewrec)());
71: case TR:
72: case X:
73: cursor += p->p1;
74: /* tab = (p->op==TR); This voids '..,tl6,1x,..' sequences */
75: tab = YES;
76: return(OK);
77: case T:
78: if(p->p1) cursor = p->p1 - recpos - 1;
79: #ifndef KOSHER
80: else cursor = 8*p->p2 - recpos%8; /* NOT STANDARD FORT */
81: #endif
82: tab = YES;
83: return(OK);
84: case TL:
85: cursor -= p->p1;
86: if ((recpos + cursor) < 0) cursor = -recpos; /* ANSI req'd */
87: tab = YES;
88: return(OK);
89: default:
90: return(errno=F_ERFMT);
91: }
92: }
93:
94: LOCAL
95: rd_mvcur()
96: { int n;
97: if(tab) return((*dotab)());
98: if (cursor < 0) return(errno=F_ERSEEK);
99: while(cursor--) if((n=(*getn)()) < 0) return(n);
100: return(cursor=0);
101: }
102:
103: LOCAL
104: rd_I(n,w,len) ftnlen len; uint *n;
105: { long x=0;
106: int i,sign=0,ch,c,sign_ok=YES;
107: for(i=0;i<w;i++)
108: {
109: if((ch=(*getn)())<0) return(ch);
110: switch(ch)
111: {
112: case ',': goto done;
113: case '-': sign=1; /* and fall thru */
114: case '+': if(sign_ok == NO) return(errno=F_ERRICHR);
115: sign_ok = NO;
116: break;
117: case ' ':
118: if(cblank) x *= radix;
119: break;
120: case '\n': if(cblank) {
121: x *= radix;
122: break;
123: } else {
124: goto done;
125: }
126: default:
127: sign_ok = NO;
128: if( (c = ch-'0')>=0 && c<radix )
129: { x = (x * radix) + c;
130: break;
131: }
132: else if( (c = low_case[ch]-'a'+10)>=0 && c<radix )
133: { x = (x * radix) + c;
134: break;
135: }
136: return(errno=F_ERRICHR);
137: }
138: }
139: done:
140: if(sign) x = -x;
141: if(len==sizeof(short)) n->is=x;
142: else n->il=x;
143: return(OK);
144: }
145:
146: LOCAL
147: rd_L(n,w,len) uint *n; ftnlen len;
148: { int ch,i,v = -1, period=0;
149: for(i=0;i<w;i++)
150: { if((ch=(*getn)()) < 0) return(ch);
151: if((ch=low_case[ch])=='t' && v==-1) v=1;
152: else if(ch=='f' && v==-1) v=0;
153: else if(ch=='.' && !period) period++;
154: else if(ch==' ' || ch=='\t') ;
155: else if(ch==',') break;
156: else if(v==-1) return(errno=F_ERLOGIF);
157: }
158: if(v==-1) return(errno=F_ERLOGIF);
159: if(len==sizeof(short)) n->is=v;
160: else n->il=v;
161: return(OK);
162: }
163:
164: LOCAL
165: rd_F(p,w,d,len) ftnlen len; ufloat *p;
166: { double x,y;
167: int i,sx,sz,ch,dot,ny,z,sawz,mode, sign_ok=YES;
168: x=y=0;
169: sawz=z=ny=dot=sx=sz=0;
170: /* modes: 0 in initial blanks,
171: 2 blanks plus sign
172: 3 found a digit
173: */
174: mode = 0;
175:
176: for(i=0;i<w;)
177: { i++;
178: if((ch=(*getn)())<0) return(ch);
179:
180: if(ch==' ') { /* blank */
181: if(cblank && (mode==2)) x *= 10;
182: } else if(ch<='9' && ch>='0') { /* digit */
183: mode = 2;
184: x=10*x+ch-'0';
185: } else if(ch=='.') {
186: break;
187: } else if(ch=='e' || ch=='d' || ch=='E' || ch=='D') {
188: goto exponent;
189: } else if(ch=='+' || ch=='-') {
190: if(mode==0) { /* sign before digits */
191: if(ch=='-') sx=1;
192: mode = 1;
193: } else if(mode==1) { /* two signs before digits */
194: return(errno=F_ERRFCHR);
195: } else { /* sign after digits, weird but standard!
196: means exponent without 'e' or 'd' */
197: goto exponent;
198: }
199: } else if(ch==',') {
200: goto done;
201: } else if(ch=='\n') {
202: if(cblank && (mode==2)) x *= 10;
203: } else {
204: return(errno=F_ERRFCHR);
205: }
206: }
207: /* get here if out of characters to scan or found a period */
208: if(ch=='.') dot=1;
209: while(i<w)
210: { i++;
211: if((ch=(*getn)())<0) return(ch);
212:
213: if(ch<='9' && ch>='0') {
214: y=10*y+ch-'0';
215: ny++;
216: } else if(ch==' ' || ch=='\n') {
217: if(cblank) {
218: y*= 10;
219: ny++;
220: }
221: } else if(ch==',') {
222: goto done;
223: } else if(ch=='d' || ch=='e' || ch=='+' || ch=='-' || ch=='D' || ch=='E') {
224: break;
225: } else {
226: return(errno=F_ERRFCHR);
227: }
228: }
229: /* now for the exponent.
230: * mode=3 means seen digit or sign of exponent.
231: * either out of characters to scan or
232: * ch is '+', '-', 'd', or 'e'.
233: */
234: exponent:
235: if(ch=='-' || ch=='+') {
236: if(ch=='-') sz=1;
237: mode = 3;
238: } else {
239: mode = 2;
240: }
241:
242: while(i<w)
243: { i++;
244: sawz=1;
245: if((ch=(*getn)())<0) return(ch);
246:
247: if(ch<='9' && ch>='0') {
248: mode = 3;
249: z=10*z+ch-'0';
250: } else if(ch=='+' || ch=='-') {
251: if(mode==3 ) return(errno=F_ERRFCHR);
252: mode = 3;
253: if(ch=='-') sz=1;
254: } else if(ch == ' ' || ch=='\n') {
255: if(cblank) z *=10;
256: } else if(ch==',') {
257: break;
258: } else {
259: return(errno=F_ERRFCHR);
260: }
261: }
262: done:
263: if(!dot)
264: for(i=0;i<d;i++) x /= 10;
265: for(i=0;i<ny;i++) y /= 10;
266: x=x+y;
267: if(sz)
268: for(i=0;i<z;i++) x /=10;
269: else for(i=0;i<z;i++) x *= 10;
270: if(sx) x = -x;
271: if(!sawz)
272: {
273: for(i=scale;i>0;i--) x /= 10;
274: for(i=scale;i<0;i++) x *= 10;
275: }
276: if(len==sizeof(float)) p->pf=x;
277: else p->pd=x;
278: return(OK);
279: }
280:
281: LOCAL
282: rd_AW(p,w,len) char *p; ftnlen len;
283: { int i,ch;
284: if(w >= len)
285: {
286: for(i=0;i<w-len;i++) GET(ch);
287: for(i=0;i<len;i++)
288: { GET(ch);
289: *p++=VAL(ch);
290: }
291: }
292: else
293: {
294: for(i=0;i<w;i++)
295: { GET(ch);
296: *p++=VAL(ch);
297: }
298: for(i=0;i<len-w;i++) *p++=' ';
299: }
300: return(OK);
301: }
302:
303: /* THIS IS NOT ALLOWED IN THE NEW STANDARD 'CAUSE IT'S WEIRD */
304: LOCAL
305: rd_H(n,s) char *s;
306: { int i,ch = 0;
307:
308: used_data = YES;
309: for(i=0;i<n;i++)
310: { if (ch != '\n')
311: GET(ch);
312: if (ch == '\n')
313: *s++ = ' ';
314: else
315: *s++ = ch;
316: }
317: return(OK);
318: }
319:
320: LOCAL
321: rd_POS(s) char *s;
322: { char quote;
323: int ch = 0;
324:
325: used_data = YES;
326: quote = *s++;
327: while(*s)
328: { if(*s==quote && *(s+1)!=quote)
329: break;
330: if (ch != '\n')
331: GET(ch);
332: if (ch == '\n')
333: *s++ = ' ';
334: else
335: *s++ = ch;
336: }
337: return(OK);
338: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.