![[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 / libI77|
Return to rdfmt.c CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / 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; unsint *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) unsint *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: mask scale since it is not used by read
177: */
178: d &= 0xff;
179:
180: for(i=0;i<w;)
181: { i++;
182: if((ch=(*getn)())<0) return(ch);
183:
184: if(ch==' ') { /* blank */
185: if(cblank && (mode==2)) x *= 10;
186: } else if(ch<='9' && ch>='0') { /* digit */
187: mode = 2;
188: x=10*x+ch-'0';
189: } else if(ch=='.') {
190: break;
191: } else if(ch=='e' || ch=='d' || ch=='E' || ch=='D') {
192: goto exponent;
193: } else if(ch=='+' || ch=='-') {
194: if(mode==0) { /* sign before digits */
195: if(ch=='-') sx=1;
196: mode = 1;
197: } else if(mode==1) { /* two signs before digits */
198: return(errno=F_ERRFCHR);
199: } else { /* sign after digits, weird but standard!
200: means exponent without 'e' or 'd' */
201: goto exponent;
202: }
203: } else if(ch==',') {
204: goto done;
205: } else if(ch=='\n') {
206: if(cblank && (mode==2)) x *= 10;
207: } else {
208: return(errno=F_ERRFCHR);
209: }
210: }
211: /* get here if out of characters to scan or found a period */
212: if(ch=='.') dot=1;
213: while(i<w)
214: { i++;
215: if((ch=(*getn)())<0) return(ch);
216:
217: if(ch<='9' && ch>='0') {
218: y=10*y+ch-'0';
219: ny++;
220: } else if(ch==' ' || ch=='\n') {
221: if(cblank) {
222: y*= 10;
223: ny++;
224: }
225: } else if(ch==',') {
226: goto done;
227: } else if(ch=='d' || ch=='e' || ch=='+' || ch=='-' || ch=='D' || ch=='E') {
228: break;
229: } else {
230: return(errno=F_ERRFCHR);
231: }
232: }
233: /* now for the exponent.
234: * mode=3 means seen digit or sign of exponent.
235: * either out of characters to scan or
236: * ch is '+', '-', 'd', or 'e'.
237: */
238: exponent:
239: if(ch=='-' || ch=='+') {
240: if(ch=='-') sz=1;
241: mode = 3;
242: } else {
243: mode = 2;
244: }
245:
246: while(i<w)
247: { i++;
248: sawz=1;
249: if((ch=(*getn)())<0) return(ch);
250:
251: if(ch<='9' && ch>='0') {
252: mode = 3;
253: z=10*z+ch-'0';
254: } else if(ch=='+' || ch=='-') {
255: if(mode==3 ) return(errno=F_ERRFCHR);
256: mode = 3;
257: if(ch=='-') sz=1;
258: } else if(ch == ' ' || ch=='\n') {
259: if(cblank) z *=10;
260: } else if(ch==',') {
261: break;
262: } else {
263: return(errno=F_ERRFCHR);
264: }
265: }
266: done:
267: if(!dot)
268: for(i=0;i<d;i++) x /= 10;
269: for(i=0;i<ny;i++) y /= 10;
270: x=x+y;
271: if(sz)
272: for(i=0;i<z;i++) x /=10;
273: else for(i=0;i<z;i++) x *= 10;
274: if(sx) x = -x;
275: if(!sawz)
276: {
277: for(i=scale;i>0;i--) x /= 10;
278: for(i=scale;i<0;i++) x *= 10;
279: }
280: if(len==sizeof(float)) p->pf=x;
281: else p->pd=x;
282: return(OK);
283: }
284:
285: LOCAL
286: rd_AW(p,w,len) char *p; ftnlen len;
287: { int i,ch;
288: if(w >= len)
289: {
290: for(i=0;i<w-len;i++) GET(ch);
291: for(i=0;i<len;i++)
292: { GET(ch);
293: *p++=VAL(ch);
294: }
295: }
296: else
297: {
298: for(i=0;i<w;i++)
299: { GET(ch);
300: *p++=VAL(ch);
301: }
302: for(i=0;i<len-w;i++) *p++=' ';
303: }
304: return(OK);
305: }
306:
307: /* THIS IS NOT ALLOWED IN THE NEW STANDARD 'CAUSE IT'S WEIRD */
308: LOCAL
309: rd_H(n,s) char *s;
310: { int i,ch = 0;
311:
312: used_data = YES;
313: for(i=0;i<n;i++)
314: { if (ch != '\n')
315: GET(ch);
316: if (ch == '\n')
317: *s++ = ' ';
318: else
319: *s++ = ch;
320: }
321: return(OK);
322: }
323:
324: LOCAL
325: rd_POS(s) char *s;
326: { char quote;
327: int ch = 0;
328:
329: used_data = YES;
330: quote = *s++;
331: while(*s)
332: { if(*s==quote && *(s+1)!=quote)
333: break;
334: if (ch != '\n')
335: GET(ch);
336: if (ch == '\n')
337: *s++ = ' ';
338: else
339: *s++ = ch;
340: }
341: return(OK);
342: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.