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,(int)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: }