1 /* 2 char id_rdfmt[] = "@(#)rdfmt.c 1.9"; 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)); 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 rd_mvcur() 89 { int n; 90 if(tab) return((*dotab)()); 91 if (cursor < 0) return(errno=F_ERSEEK); 92 while(cursor--) if((n=(*getn)()) < 0) return(n); 93 return(cursor=0); 94 } 95 96 rd_I(n,w,len) ftnlen len; uint *n; 97 { long x=0; 98 int i,sign=0,ch,c,sign_ok=YES; 99 for(i=0;i<w;i++) 100 { 101 if((ch=(*getn)())<0) return(ch); 102 switch(ch) 103 { 104 case ',': goto done; 105 case '-': sign=1; /* and fall thru */ 106 case '+': if(sign_ok == NO) return(errno=F_ERRICHR); 107 sign_ok = NO; 108 break; 109 case ' ': 110 if(cblank) x *= radix; 111 break; 112 case '\n': if(cblank) { 113 x *= radix; 114 break; 115 } else { 116 goto done; 117 } 118 default: 119 sign_ok = NO; 120 if( (c = ch-'0')>=0 && c<radix ) 121 { x = (x * radix) + c; 122 break; 123 } 124 else if( (c = low_case[ch]-'a'+10)>=0 && c<radix ) 125 { x = (x * radix) + c; 126 break; 127 } 128 return(errno=F_ERRICHR); 129 } 130 } 131 done: 132 if(sign) x = -x; 133 if(len==sizeof(short)) n->is=x; 134 else n->il=x; 135 return(OK); 136 } 137 138 rd_L(n,w) ftnint *n; 139 { int ch,i,v = -1; 140 for(i=0;i<w;i++) 141 { if((ch=(*getn)()) < 0) return(ch); 142 if((ch=low_case[ch])=='t' && v==-1) v=1; 143 else if(ch=='f' && v==-1) v=0; 144 else if(ch==',') break; 145 } 146 if(v==-1) return(errno=F_ERLOGIF); 147 *n=v; 148 return(OK); 149 } 150 151 rd_F(p,w,d,len) ftnlen len; ufloat *p; 152 { double x,y; 153 int i,sx,sz,ch,dot,ny,z,sawz,mode, sign_ok=YES; 154 x=y=0; 155 sawz=z=ny=dot=sx=sz=0; 156 /* modes: 0 in initial blanks, 157 2 blanks plus sign 158 3 found a digit 159 */ 160 mode = 0; 161 162 for(i=0;i<w;) 163 { i++; 164 if((ch=(*getn)())<0) return(ch); 165 166 if(ch==' ') { /* blank */ 167 if(cblank && (mode==2)) x *= 10; 168 } else if(ch<='9' && ch>='0') { /* digit */ 169 mode = 2; 170 x=10*x+ch-'0'; 171 } else if(ch=='.') { 172 break; 173 } else if(ch=='e' || ch=='d' || ch=='E' || ch=='D') { 174 goto exponent; 175 } else if(ch=='+' || ch=='-') { 176 if(mode==0) { /* sign before digits */ 177 if(ch=='-') sx=1; 178 mode = 1; 179 } else if(mode==1) { /* two signs before digits */ 180 return(errno=F_ERRFCHR); 181 } else { /* sign after digits, weird but standard! 182 means exponent without 'e' or 'd' */ 183 goto exponent; 184 } 185 } else if(ch==',') { 186 goto done; 187 } else if(ch=='\n') { 188 if(cblank && (mode==2)) x *= 10; 189 } else { 190 return(errno=F_ERRFCHR); 191 } 192 } 193 /* get here if out of characters to scan or found a period */ 194 if(ch=='.') dot=1; 195 while(i<w) 196 { i++; 197 if((ch=(*getn)())<0) return(ch); 198 199 if(ch<='9' && ch>='0') { 200 y=10*y+ch-'0'; 201 ny++; 202 } else if(ch==' ' || ch=='\n') { 203 if(cblank) { 204 y*= 10; 205 ny++; 206 } 207 } else if(ch==',') { 208 goto done; 209 } else if(ch=='d' || ch=='e' || ch=='+' || ch=='-' || ch=='D' || ch=='E') { 210 break; 211 } else { 212 return(errno=F_ERRFCHR); 213 } 214 } 215 /* now for the exponent. 216 * mode=3 means seen digit or sign of exponent. 217 * either out of characters to scan or 218 * ch is '+', '-', 'd', or 'e'. 219 */ 220 exponent: 221 if(ch=='-' || ch=='+') { 222 if(ch=='-') sz=1; 223 mode = 3; 224 } else { 225 mode = 2; 226 } 227 228 while(i<w) 229 { i++; 230 sawz=1; 231 if((ch=(*getn)())<0) return(ch); 232 233 if(ch<='9' && ch>='0') { 234 mode = 3; 235 z=10*z+ch-'0'; 236 } else if(ch=='+' || ch=='-') { 237 if(mode==3 ) return(errno=F_ERRFCHR); 238 mode = 3; 239 if(ch=='-') sz=1; 240 } else if(ch == ' ' || ch=='\n') { 241 if(cblank) z *=10; 242 } else if(ch==',') { 243 break; 244 } else { 245 return(errno=F_ERRFCHR); 246 } 247 } 248 done: 249 if(!dot) 250 for(i=0;i<d;i++) x /= 10; 251 for(i=0;i<ny;i++) y /= 10; 252 x=x+y; 253 if(sz) 254 for(i=0;i<z;i++) x /=10; 255 else for(i=0;i<z;i++) x *= 10; 256 if(sx) x = -x; 257 if(!sawz) 258 { 259 for(i=scale;i>0;i--) x /= 10; 260 for(i=scale;i<0;i++) x *= 10; 261 } 262 if(len==sizeof(float)) p->pf=x; 263 else p->pd=x; 264 return(OK); 265 } 266 267 rd_AW(p,w,len) char *p; ftnlen len; 268 { int i,ch; 269 if(w >= len) 270 { 271 for(i=0;i<w-len;i++) GET(ch); 272 for(i=0;i<len;i++) 273 { GET(ch); 274 *p++=VAL(ch); 275 } 276 } 277 else 278 { 279 for(i=0;i<w;i++) 280 { GET(ch); 281 *p++=VAL(ch); 282 } 283 for(i=0;i<len-w;i++) *p++=' '; 284 } 285 return(OK); 286 } 287 288 /* THIS IS NOT ALLOWED IN THE NEW STANDARD 'CAUSE IT'S WEIRD */ 289 rd_H(n,s) char *s; 290 { int i,ch = 0; 291 292 used_data = YES; 293 for(i=0;i<n;i++) 294 { if (ch != '\n') 295 GET(ch); 296 if (ch == '\n') 297 *s++ = ' '; 298 else 299 *s++ = ch; 300 } 301 return(OK); 302 } 303 304 rd_POS(s) char *s; 305 { char quote; 306 int ch = 0; 307 308 used_data = YES; 309 quote = *s++; 310 while(*s) 311 { if(*s==quote && *(s+1)!=quote) 312 break; 313 if (ch != '\n') 314 GET(ch); 315 if (ch == '\n') 316 *s++ = ' '; 317 else 318 *s++ = ch; 319 } 320 return(OK); 321 } 322