|
|
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.