![[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] / 42BSD / usr.lib / libI77|
Return to rdfmt.c CVS log | Up to [CSRG BSD Unix] / 42BSD / usr.lib / libI77 |
1.1 root 1: /*
2: char id_rdfmt[] = "@(#)rdfmt.c 1.5";
3: *
4: * formatted read routines
5: */
6:
7: #include "fio.h"
8: #include "format.h"
9:
10: #define isdigit(c) (c>='0' && c<='9')
11: #define isalpha(c) (c>='a' && c<='z')
12:
13: rd_ed(p,ptr,len) char *ptr; struct syl *p; ftnlen len;
14: { int n;
15: if(cursor && (n=rd_mvcur())) return(n);
16: switch(p->op)
17: {
18: case I:
19: case IM:
20: n = (rd_I(ptr,p->p1,len));
21: break;
22: case L:
23: n = (rd_L(ptr,p->p1));
24: break;
25: case A:
26: p->p1 = len; /* cheap trick */
27: case AW:
28: n = (rd_AW(ptr,p->p1,len));
29: break;
30: case E:
31: case EE:
32: case D:
33: case DE:
34: case G:
35: case GE:
36: case F:
37: n = (rd_F(ptr,p->p1,p->p2,len));
38: break;
39: default:
40: return(errno=F_ERFMT);
41: }
42: if (n < 0)
43: {
44: if(feof(cf)) return(EOF);
45: n = errno;
46: clearerr(cf);
47: }
48: return(n);
49: }
50:
51: rd_ned(p,ptr) char *ptr; struct syl *p;
52: {
53: switch(p->op)
54: {
55: #ifndef KOSHER
56: case APOS: /* NOT STANDARD F77 */
57: return(rd_POS((char *)p->p1));
58: case H: /* NOT STANDARD F77 */
59: return(rd_H(p->p1,(char *)p->p2));
60: #endif
61: case SLASH:
62: return((*donewrec)());
63: case TR:
64: case X:
65: cursor += p->p1;
66: /* tab = (p->op==TR); This voids '..,tl6,1x,..' sequences */
67: tab = YES;
68: return(OK);
69: case T:
70: if(p->p1) cursor = p->p1 - recpos - 1;
71: #ifndef KOSHER
72: else cursor = 8*p->p2 - recpos%8; /* NOT STANDARD FORT */
73: #endif
74: tab = YES;
75: return(OK);
76: case TL:
77: cursor -= p->p1;
78: if ((recpos + cursor) < 0) cursor = -recpos; /* ANSI req'd */
79: tab = YES;
80: return(OK);
81: default:
82: return(errno=F_ERFMT);
83: }
84: }
85:
86: rd_mvcur()
87: { int n;
88: if(tab) return((*dotab)());
89: if (cursor < 0) return(errno=F_ERSEEK);
90: while(cursor--) if((n=(*getn)()) < 0) return(n);
91: return(cursor=0);
92: }
93:
94: rd_I(n,w,len) ftnlen len; uint *n;
95: { long x=0;
96: int i,sign=0,ch,c;
97: for(i=0;i<w;i++)
98: {
99: if((ch=(*getn)())<0) return(ch);
100: switch(ch=lcase(ch))
101: {
102: case ',': goto done;
103: case '+': break;
104: case '-':
105: sign=1;
106: break;
107: case ' ':
108: if(cblank) x *= radix;
109: break;
110: case '\n': goto done;
111: default:
112: if(isdigit(ch))
113: { if ((c=(ch-'0')) < radix)
114: { x = (x * radix) + c;
115: break;
116: }
117: }
118: else if(isalpha(ch))
119: { if ((c=(ch-'a'+10)) < radix)
120: { x = (x * radix) + c;
121: break;
122: }
123: }
124: return(errno=F_ERRDCHR);
125: }
126: }
127: done:
128: if(sign) x = -x;
129: if(len==sizeof(short)) n->is=x;
130: else n->il=x;
131: return(OK);
132: }
133:
134: rd_L(n,w) ftnint *n;
135: { int ch,i,v = -1;
136: for(i=0;i<w;i++)
137: { if((ch=(*getn)()) < 0) return(ch);
138: if((ch=lcase(ch))=='t' && v==-1) v=1;
139: else if(ch=='f' && v==-1) v=0;
140: else if(ch==',') break;
141: }
142: if(v==-1) return(errno=F_ERLOGIF);
143: *n=v;
144: return(OK);
145: }
146:
147: rd_F(p,w,d,len) ftnlen len; ufloat *p;
148: { double x,y;
149: int i,sx,sz,ch,dot,ny,z,sawz;
150: x=y=0;
151: sawz=z=ny=dot=sx=sz=0;
152: for(i=0;i<w;)
153: { i++;
154: if((ch=(*getn)())<0) return(ch);
155: ch=lcase(ch);
156: if(ch==' ' && !cblank || ch=='+') continue;
157: else if(ch=='-') sx=1;
158: else if(ch<='9' && ch>='0')
159: x=10*x+ch-'0';
160: else if(ch=='e' || ch=='d' || ch=='.')
161: break;
162: else if(cblank && ch==' ') x*=10;
163: else if(ch==',')
164: { i=w;
165: break;
166: }
167: else if(ch!='\n') return(errno=F_ERRDCHR);
168: }
169: if(ch=='.') dot=1;
170: while(i<w && ch!='e' && ch!='d' && ch!='+' && ch!='-')
171: { i++;
172: if((ch=(*getn)())<0) return(ch);
173: ch = lcase(ch);
174: if(ch<='9' && ch>='0')
175: y=10*y+ch-'0';
176: else if(cblank && ch==' ')
177: y *= 10;
178: else if(ch==',') {i=w; break;}
179: else if(ch==' ') continue;
180: else continue;
181: ny++;
182: }
183: if(ch=='-') sz=1;
184: while(i<w)
185: { i++;
186: sawz=1;
187: if((ch=(*getn)())<0) return(ch);
188: ch = lcase(ch);
189: if(ch=='-') sz=1;
190: else if(ch<='9' && ch>='0')
191: z=10*z+ch-'0';
192: else if(cblank && ch==' ')
193: z *= 10;
194: else if(ch==',') break;
195: else if(ch==' ') continue;
196: else if(ch=='+') continue;
197: else if(ch!='\n') return(errno=F_ERRDCHR);
198: }
199: if(!dot)
200: for(i=0;i<d;i++) x /= 10;
201: for(i=0;i<ny;i++) y /= 10;
202: x=x+y;
203: if(sz)
204: for(i=0;i<z;i++) x /=10;
205: else for(i=0;i<z;i++) x *= 10;
206: if(sx) x = -x;
207: if(!sawz)
208: {
209: for(i=scale;i>0;i--) x /= 10;
210: for(i=scale;i<0;i++) x *= 10;
211: }
212: if(len==sizeof(float)) p->pf=x;
213: else p->pd=x;
214: return(OK);
215: }
216:
217: rd_AW(p,w,len) char *p; ftnlen len;
218: { int i,ch;
219: if(w >= len)
220: {
221: for(i=0;i<w-len;i++) GET(ch);
222: for(i=0;i<len;i++)
223: { GET(ch);
224: *p++=VAL(ch);
225: }
226: }
227: else
228: {
229: for(i=0;i<w;i++)
230: { GET(ch);
231: *p++=VAL(ch);
232: }
233: for(i=0;i<len-w;i++) *p++=' ';
234: }
235: return(OK);
236: }
237:
238: /* THIS IS NOT ALLOWED IN THE NEW STANDARD 'CAUSE IT'S WEIRD */
239: rd_H(n,s) char *s;
240: { int i,ch = 0;
241: for(i=0;i<n;i++)
242: { if (ch != '\n')
243: GET(ch);
244: if (ch == '\n')
245: *s++ = ' ';
246: else
247: *s++ = ch;
248: }
249: return(OK);
250: }
251:
252: rd_POS(s) char *s;
253: { char quote;
254: int ch = 0;
255: quote = *s++;
256: while(*s)
257: { if(*s==quote && *(s+1)!=quote)
258: break;
259: if (ch != '\n')
260: GET(ch);
261: if (ch == '\n')
262: *s++ = ' ';
263: else
264: *s++ = ch;
265: }
266: return(OK);
267: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.