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: }

Defined functions

rd_AW defined in line 281; used 2 times
rd_F defined in line 164; used 1 times
  • in line 45
rd_H defined in line 304; used 1 times
  • in line 67
rd_I defined in line 103; used 1 times
  • in line 27
rd_L defined in line 146; used 1 times
  • in line 30
rd_POS defined in line 320; used 1 times
  • in line 65
rd_mvcur defined in line 94; used 1 times
  • in line 22
Last modified: 1988-06-13
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 2835
Valid CSS Valid XHTML 1.0 Strict