1 /* 2 char id_rdfmt[] = "@(#)rdfmt.c 1.11"; 3 * 4 * formatted read routines 5 */ 6 7 #include "fio.h" 8 #include "format.h" 9 10 extern char *s_init; 11 extern int low_case[256]; 12 extern int used_data; 13 14 rd_ed(p,ptr,len) char *ptr; struct syl *p; ftnlen len; 15 { int n; 16 if(cursor && (n=rd_mvcur())) return(n); 17 switch(p->op) 18 { 19 case I: 20 case IM: 21 n = (rd_I(ptr,p->p1,len)); 22 break; 23 case L: 24 n = (rd_L(ptr,p->p1,len)); 25 break; 26 case A: 27 n = (rd_AW(ptr,len,len)); 28 break; 29 case AW: 30 n = (rd_AW(ptr,p->p1,len)); 31 break; 32 case E: 33 case EE: 34 case D: 35 case DE: 36 case G: 37 case GE: 38 case F: 39 n = (rd_F(ptr,p->p1,p->p2,len)); 40 break; 41 default: 42 return(errno=F_ERFMT); 43 } 44 if (n < 0) 45 { 46 if(feof(cf)) return(EOF); 47 n = errno; 48 clearerr(cf); 49 } 50 return(n); 51 } 52 53 rd_ned(p,ptr) char *ptr; struct syl *p; 54 { 55 switch(p->op) 56 { 57 #ifndef KOSHER 58 case APOS: /* NOT STANDARD F77 */ 59 return(rd_POS(&s_init[p->p1])); 60 case H: /* NOT STANDARD F77 */ 61 return(rd_H(p->p1,&s_init[p->p2])); 62 #endif 63 case SLASH: 64 return((*donewrec)()); 65 case TR: 66 case X: 67 cursor += p->p1; 68 /* tab = (p->op==TR); This voids '..,tl6,1x,..' sequences */ 69 tab = YES; 70 return(OK); 71 case T: 72 if(p->p1) cursor = p->p1 - recpos - 1; 73 #ifndef KOSHER 74 else cursor = 8*p->p2 - recpos%8; /* NOT STANDARD FORT */ 75 #endif 76 tab = YES; 77 return(OK); 78 case TL: 79 cursor -= p->p1; 80 if ((recpos + cursor) < 0) cursor = -recpos; /* ANSI req'd */ 81 tab = YES; 82 return(OK); 83 default: 84 return(errno=F_ERFMT); 85 } 86 } 87 88 LOCAL 89 rd_mvcur() 90 { int n; 91 if(tab) return((*dotab)()); 92 if (cursor < 0) return(errno=F_ERSEEK); 93 while(cursor--) if((n=(*getn)()) < 0) return(n); 94 return(cursor=0); 95 } 96 97 LOCAL 98 rd_I(n,w,len) ftnlen len; uint *n; 99 { long x=0; 100 int i,sign=0,ch,c,sign_ok=YES; 101 for(i=0;i<w;i++) 102 { 103 if((ch=(*getn)())<0) return(ch); 104 switch(ch) 105 { 106 case ',': goto done; 107 case '-': sign=1; /* and fall thru */ 108 case '+': if(sign_ok == NO) return(errno=F_ERRICHR); 109 sign_ok = NO; 110 break; 111 case ' ': 112 if(cblank) x *= radix; 113 break; 114 case '\n': if(cblank) { 115 x *= radix; 116 break; 117 } else { 118 goto done; 119 } 120 default: 121 sign_ok = NO; 122 if( (c = ch-'0')>=0 && c<radix ) 123 { x = (x * radix) + c; 124 break; 125 } 126 else if( (c = low_case[ch]-'a'+10)>=0 && c<radix ) 127 { x = (x * radix) + c; 128 break; 129 } 130 return(errno=F_ERRICHR); 131 } 132 } 133 done: 134 if(sign) x = -x; 135 if(len==sizeof(short)) n->is=x; 136 else n->il=x; 137 return(OK); 138 } 139 140 LOCAL 141 rd_L(n,w,len) uint *n; ftnlen len; 142 { int ch,i,v = -1; 143 for(i=0;i<w;i++) 144 { if((ch=(*getn)()) < 0) return(ch); 145 if((ch=low_case[ch])=='t' && v==-1) v=1; 146 else if(ch=='f' && v==-1) v=0; 147 else if(ch==',') break; 148 } 149 if(v==-1) return(errno=F_ERLOGIF); 150 if(len==sizeof(short)) n->is=v; 151 else n->il=v; 152 return(OK); 153 } 154 155 LOCAL 156 rd_F(p,w,d,len) ftnlen len; ufloat *p; 157 { double x,y; 158 int i,sx,sz,ch,dot,ny,z,sawz,mode, sign_ok=YES; 159 x=y=0; 160 sawz=z=ny=dot=sx=sz=0; 161 /* modes: 0 in initial blanks, 162 2 blanks plus sign 163 3 found a digit 164 */ 165 mode = 0; 166 167 for(i=0;i<w;) 168 { i++; 169 if((ch=(*getn)())<0) return(ch); 170 171 if(ch==' ') { /* blank */ 172 if(cblank && (mode==2)) x *= 10; 173 } else if(ch<='9' && ch>='0') { /* digit */ 174 mode = 2; 175 x=10*x+ch-'0'; 176 } else if(ch=='.') { 177 break; 178 } else if(ch=='e' || ch=='d' || ch=='E' || ch=='D') { 179 goto exponent; 180 } else if(ch=='+' || ch=='-') { 181 if(mode==0) { /* sign before digits */ 182 if(ch=='-') sx=1; 183 mode = 1; 184 } else if(mode==1) { /* two signs before digits */ 185 return(errno=F_ERRFCHR); 186 } else { /* sign after digits, weird but standard! 187 means exponent without 'e' or 'd' */ 188 goto exponent; 189 } 190 } else if(ch==',') { 191 goto done; 192 } else if(ch=='\n') { 193 if(cblank && (mode==2)) x *= 10; 194 } else { 195 return(errno=F_ERRFCHR); 196 } 197 } 198 /* get here if out of characters to scan or found a period */ 199 if(ch=='.') dot=1; 200 while(i<w) 201 { i++; 202 if((ch=(*getn)())<0) return(ch); 203 204 if(ch<='9' && ch>='0') { 205 y=10*y+ch-'0'; 206 ny++; 207 } else if(ch==' ' || ch=='\n') { 208 if(cblank) { 209 y*= 10; 210 ny++; 211 } 212 } else if(ch==',') { 213 goto done; 214 } else if(ch=='d' || ch=='e' || ch=='+' || ch=='-' || ch=='D' || ch=='E') { 215 break; 216 } else { 217 return(errno=F_ERRFCHR); 218 } 219 } 220 /* now for the exponent. 221 * mode=3 means seen digit or sign of exponent. 222 * either out of characters to scan or 223 * ch is '+', '-', 'd', or 'e'. 224 */ 225 exponent: 226 if(ch=='-' || ch=='+') { 227 if(ch=='-') sz=1; 228 mode = 3; 229 } else { 230 mode = 2; 231 } 232 233 while(i<w) 234 { i++; 235 sawz=1; 236 if((ch=(*getn)())<0) return(ch); 237 238 if(ch<='9' && ch>='0') { 239 mode = 3; 240 z=10*z+ch-'0'; 241 } else if(ch=='+' || ch=='-') { 242 if(mode==3 ) return(errno=F_ERRFCHR); 243 mode = 3; 244 if(ch=='-') sz=1; 245 } else if(ch == ' ' || ch=='\n') { 246 if(cblank) z *=10; 247 } else if(ch==',') { 248 break; 249 } else { 250 return(errno=F_ERRFCHR); 251 } 252 } 253 done: 254 if(!dot) 255 for(i=0;i<d;i++) x /= 10; 256 for(i=0;i<ny;i++) y /= 10; 257 x=x+y; 258 if(sz) 259 for(i=0;i<z;i++) x /=10; 260 else for(i=0;i<z;i++) x *= 10; 261 if(sx) x = -x; 262 if(!sawz) 263 { 264 for(i=scale;i>0;i--) x /= 10; 265 for(i=scale;i<0;i++) x *= 10; 266 } 267 if(len==sizeof(float)) p->pf=x; 268 else p->pd=x; 269 return(OK); 270 } 271 272 LOCAL 273 rd_AW(p,w,len) char *p; ftnlen len; 274 { int i,ch; 275 if(w >= len) 276 { 277 for(i=0;i<w-len;i++) GET(ch); 278 for(i=0;i<len;i++) 279 { GET(ch); 280 *p++=VAL(ch); 281 } 282 } 283 else 284 { 285 for(i=0;i<w;i++) 286 { GET(ch); 287 *p++=VAL(ch); 288 } 289 for(i=0;i<len-w;i++) *p++=' '; 290 } 291 return(OK); 292 } 293 294 /* THIS IS NOT ALLOWED IN THE NEW STANDARD 'CAUSE IT'S WEIRD */ 295 LOCAL 296 rd_H(n,s) char *s; 297 { int i,ch = 0; 298 299 used_data = YES; 300 for(i=0;i<n;i++) 301 { if (ch != '\n') 302 GET(ch); 303 if (ch == '\n') 304 *s++ = ' '; 305 else 306 *s++ = ch; 307 } 308 return(OK); 309 } 310 311 LOCAL 312 rd_POS(s) char *s; 313 { char quote; 314 int ch = 0; 315 316 used_data = YES; 317 quote = *s++; 318 while(*s) 319 { if(*s==quote && *(s+1)!=quote) 320 break; 321 if (ch != '\n') 322 GET(ch); 323 if (ch == '\n') 324 *s++ = ' '; 325 else 326 *s++ = ch; 327 } 328 return(OK); 329 } 330