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