![[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 [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.lib / libsI77|
Return to rdfmt.c CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.lib / libsI77 |
1.1 root 1: /*
2: char id_rdfmt[] = "@(#)rdfmt.c 1.2";
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:
57: return(rd_POS(p->p1));
58: case H:
59: return(rd_H(p->p1,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);
67: return(OK);
68: case T:
69: if(p->p1) cursor = p->p1 - recpos - 1;
70: #ifndef KOSHER
71: else cursor = 8*p->p2 - recpos%8; /* NOT STANDARD FORT */
72: #endif
73: tab = YES;
74: return(OK);
75: case TL:
76: cursor -= p->p1;
77: tab = YES;
78: return(OK);
79: default:
80: return(errno=F_ERFMT);
81: }
82: }
83:
84: rd_mvcur()
85: { int n;
86: if(tab) return((*dotab)());
87: while(cursor--) if((n=(*getn)()) < 0) return(n);
88: return(cursor=0);
89: }
90:
91: rd_I(n,w,len) ftnlen len; uint *n;
92: { long x=0;
93: int i,sign=0,ch,c;
94: for(i=0;i<w;i++)
95: {
96: if((ch=(*getn)())<0) return(ch);
97: switch(ch=lcase(ch))
98: {
99: case ',': goto done;
100: case '+': break;
101: case '-':
102: sign=1;
103: break;
104: case ' ':
105: if(cblank) x *= radix;
106: break;
107: case '\n': goto done;
108: default:
109: if(isdigit(ch))
110: { if ((c=(ch-'0')) < radix)
111: { x = (x * radix) + c;
112: break;
113: }
114: }
115: else if(isalpha(ch))
116: { if ((c=(ch-'a'+10)) < radix)
117: { x = (x * radix) + c;
118: break;
119: }
120: }
121: return(errno=F_ERRDCHR);
122: }
123: }
124: done:
125: if(sign) x = -x;
126: if(len==sizeof(short)) n->is=x;
127: else n->il=x;
128: return(OK);
129: }
130:
131: rd_L(n,w) ftnint *n;
132: { int ch,i,v = -1;
133: for(i=0;i<w;i++)
134: { if((ch=(*getn)()) < 0) return(ch);
135: if((ch=lcase(ch))=='t' && v==-1) v=1;
136: else if(ch=='f' && v==-1) v=0;
137: else if(ch==',') break;
138: }
139: if(v==-1) return(errno=F_ERLOGIF);
140: *n=v;
141: return(OK);
142: }
143:
144: rd_F(p,w,d,len) ftnlen len; ufloat *p;
145: { double x,y;
146: int i,sx,sz,ch,dot,ny,z,sawz;
147: x=y=0;
148: sawz=z=ny=dot=sx=sz=0;
149: for(i=0;i<w;)
150: { i++;
151: if((ch=(*getn)())<0) return(ch);
152: ch=lcase(ch);
153: if(ch==' ' && !cblank || ch=='+') continue;
154: else if(ch=='-') sx=1;
155: else if(ch<='9' && ch>='0')
156: x=10*x+ch-'0';
157: else if(ch=='e' || ch=='d' || ch=='.')
158: break;
159: else if(cblank && ch==' ') x*=10;
160: else if(ch==',')
161: { i=w;
162: break;
163: }
164: else if(ch!='\n') return(errno=F_ERRDCHR);
165: }
166: if(ch=='.') dot=1;
167: while(i<w && ch!='e' && ch!='d' && ch!='+' && ch!='-')
168: { i++;
169: if((ch=(*getn)())<0) return(ch);
170: ch = lcase(ch);
171: if(ch<='9' && ch>='0')
172: y=10*y+ch-'0';
173: else if(cblank && ch==' ')
174: y *= 10;
175: else if(ch==',') {i=w; break;}
176: else if(ch==' ') continue;
177: else continue;
178: ny++;
179: }
180: if(ch=='-') sz=1;
181: while(i<w)
182: { i++;
183: sawz=1;
184: if((ch=(*getn)())<0) return(ch);
185: ch = lcase(ch);
186: if(ch=='-') sz=1;
187: else if(ch<='9' && ch>='0')
188: z=10*z+ch-'0';
189: else if(cblank && ch==' ')
190: z *= 10;
191: else if(ch==',') break;
192: else if(ch==' ') continue;
193: else if(ch=='+') continue;
194: else if(ch!='\n') return(errno=F_ERRDCHR);
195: }
196: if(!dot)
197: for(i=0;i<d;i++) x /= 10;
198: for(i=0;i<ny;i++) y /= 10;
199: x=x+y;
200: if(sz)
201: for(i=0;i<z;i++) x /=10;
202: else for(i=0;i<z;i++) x *= 10;
203: if(sx) x = -x;
204: if(!sawz)
205: {
206: for(i=scale;i>0;i--) x /= 10;
207: for(i=scale;i<0;i++) x *= 10;
208: }
209: if(len==sizeof(float)) p->pf=x;
210: else p->pd=x;
211: return(OK);
212: }
213:
214: rd_AW(p,w,len) char *p; ftnlen len;
215: { int i,ch;
216: if(w >= len)
217: {
218: for(i=0;i<w-len;i++) GET(ch);
219: for(i=0;i<len;i++)
220: { GET(ch);
221: *p++=VAL(ch);
222: }
223: }
224: else
225: {
226: for(i=0;i<w;i++)
227: { GET(ch);
228: *p++=VAL(ch);
229: }
230: for(i=0;i<len-w;i++) *p++=' ';
231: }
232: return(OK);
233: }
234:
235: /* THIS IS NOT ALLOWED IN THE NEW STANDARD 'CAUSE IT'S WEIRD */
236: rd_H(n,s) char *s;
237: { int i,ch;
238: for(i=0;i<n;i++)
239: if((ch=(*getn)())<0) return(ch);
240: else if(ch=='\n') for(;i<n;i++) *s++ = ' ';
241: else *s++ = ch;
242: return(OK);
243: }
244:
245: rd_POS(s) char *s;
246: { char quote;
247: int ch;
248: quote= *s++;
249: for(;*s;s++)
250: if(*s==quote && *(s+1)!=quote) break;
251: else if((ch=(*getn)())<0) return(ch);
252: else *s = ch=='\n'?' ':ch;
253: return(OK);
254: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.