2.9BSD - /usr/src/lib/libI77/rdfmt.c

   1: /*
   2: char id_rdfmt[] = "@(#)rdfmt.c	1.5";
   3:  *
   4:  * formatted read routines
   5:  */
   6: 
   7: #include "fio.h"
   8: #include "format.h"
   9: 
  10: #define isdigit(c)  (c>='0' && c<='9')
  11: #define isalpha(c)  (c>='a' && c<='z')
  12: 
  13: rd_ed(p,ptr,len) char *ptr; struct syl *p; ftnlen len;
  14: {   int n;
  15:     if(cursor && (n=rd_mvcur())) return(n);
  16:     switch(p->op)
  17:     {
  18:     case I:
  19:     case IM:
  20:         n = (rd_I(ptr,p->p1,len));
  21:         break;
  22:     case L:
  23:         n = (rd_L(ptr,p->p1));
  24:         break;
  25:     case A:
  26:         p->p1 = len;    /* cheap trick */
  27:     case AW:
  28:         n = (rd_AW(ptr,p->p1,len));
  29:         break;
  30:     case E:
  31:     case EE:
  32:     case D:
  33:     case DE:
  34:     case G:
  35:     case GE:
  36:     case F:
  37:         n = (rd_F(ptr,p->p1,p->p2,len));
  38:         break;
  39:     default:
  40:         return(errno=F_ERFMT);
  41:     }
  42:     if (n < 0)
  43:     {
  44:         if(feof(cf)) return(EOF);
  45:         n = errno;
  46:         clearerr(cf);
  47:     }
  48:     return(n);
  49: }
  50: 
  51: rd_ned(p,ptr) char *ptr; struct syl *p;
  52: {
  53:     switch(p->op)
  54:     {
  55: #ifndef KOSHER
  56:     case APOS:                  /* NOT STANDARD F77 */
  57:         return(rd_POS((char *)p->p1));
  58:     case H:                     /* NOT STANDARD F77 */
  59:         return(rd_H(p->p1,(char *)p->p2));
  60: #endif
  61:     case SLASH:
  62:         return((*donewrec)());
  63:     case TR:
  64:     case X:
  65:         cursor += p->p1;
  66:         /* tab = (p->op==TR); This voids '..,tl6,1x,..' sequences */
  67:         tab = YES;
  68:         return(OK);
  69:     case T:
  70:         if(p->p1) cursor = p->p1 - recpos - 1;
  71: #ifndef KOSHER
  72:         else cursor = 8*p->p2 - recpos%8;   /* NOT STANDARD FORT */
  73: #endif
  74:         tab = YES;
  75:         return(OK);
  76:     case TL:
  77:         cursor -= p->p1;
  78:         if ((recpos + cursor) < 0) cursor = -recpos;    /* ANSI req'd */
  79:         tab = YES;
  80:         return(OK);
  81:     default:
  82:         return(errno=F_ERFMT);
  83:     }
  84: }
  85: 
  86: rd_mvcur()
  87: {   int n;
  88:     if(tab) return((*dotab)());
  89:     if (cursor < 0) return(errno=F_ERSEEK);
  90:     while(cursor--) if((n=(*getn)()) < 0) return(n);
  91:     return(cursor=0);
  92: }
  93: 
  94: rd_I(n,w,len) ftnlen len; uint *n;
  95: {   long x=0;
  96:     int i,sign=0,ch,c;
  97:     for(i=0;i<w;i++)
  98:     {
  99:         if((ch=(*getn)())<0) return(ch);
 100:         switch(ch=lcase(ch))
 101:         {
 102:         case ',': goto done;
 103:         case '+': break;
 104:         case '-':
 105:             sign=1;
 106:             break;
 107:         case ' ':
 108:             if(cblank) x *= radix;
 109:             break;
 110:         case '\n':  goto done;
 111:         default:
 112:             if(isdigit(ch))
 113:             {   if ((c=(ch-'0')) < radix)
 114:                 {   x = (x * radix) + c;
 115:                     break;
 116:                 }
 117:             }
 118:             else if(isalpha(ch))
 119:             {   if ((c=(ch-'a'+10)) < radix)
 120:                 {   x = (x * radix) + c;
 121:                     break;
 122:                 }
 123:             }
 124:             return(errno=F_ERRDCHR);
 125:         }
 126:     }
 127: done:
 128:     if(sign) x = -x;
 129:     if(len==sizeof(short)) n->is=x;
 130:     else n->il=x;
 131:     return(OK);
 132: }
 133: 
 134: rd_L(n,w) ftnint *n;
 135: {   int ch,i,v = -1;
 136:     for(i=0;i<w;i++)
 137:     {   if((ch=(*getn)()) < 0) return(ch);
 138:         if((ch=lcase(ch))=='t' && v==-1) v=1;
 139:         else if(ch=='f' && v==-1) v=0;
 140:         else if(ch==',') break;
 141:     }
 142:     if(v==-1) return(errno=F_ERLOGIF);
 143:     *n=v;
 144:     return(OK);
 145: }
 146: 
 147: rd_F(p,w,d,len) ftnlen len; ufloat *p;
 148: {   double x,y;
 149:     int i,sx,sz,ch,dot,ny,z,sawz;
 150:     x=y=0;
 151:     sawz=z=ny=dot=sx=sz=0;
 152:     for(i=0;i<w;)
 153:     {   i++;
 154:         if((ch=(*getn)())<0) return(ch);
 155:         ch=lcase(ch);
 156:         if(ch==' ' && !cblank || ch=='+') continue;
 157:         else if(ch=='-') sx=1;
 158:         else if(ch<='9' && ch>='0')
 159:             x=10*x+ch-'0';
 160:         else if(ch=='e' || ch=='d' || ch=='.')
 161:             break;
 162:         else if(cblank && ch==' ') x*=10;
 163:         else if(ch==',')
 164:         {   i=w;
 165:             break;
 166:         }
 167:         else if(ch!='\n') return(errno=F_ERRDCHR);
 168:     }
 169:     if(ch=='.') dot=1;
 170:     while(i<w && ch!='e' && ch!='d' && ch!='+' && ch!='-')
 171:     {   i++;
 172:         if((ch=(*getn)())<0) return(ch);
 173:         ch = lcase(ch);
 174:         if(ch<='9' && ch>='0')
 175:             y=10*y+ch-'0';
 176:         else if(cblank && ch==' ')
 177:             y *= 10;
 178:         else if(ch==',') {i=w; break;}
 179:         else if(ch==' ') continue;
 180:         else continue;
 181:         ny++;
 182:     }
 183:     if(ch=='-') sz=1;
 184:     while(i<w)
 185:     {   i++;
 186:         sawz=1;
 187:         if((ch=(*getn)())<0) return(ch);
 188:         ch = lcase(ch);
 189:         if(ch=='-') sz=1;
 190:         else if(ch<='9' && ch>='0')
 191:             z=10*z+ch-'0';
 192:         else if(cblank && ch==' ')
 193:             z *= 10;
 194:         else if(ch==',') break;
 195:         else if(ch==' ') continue;
 196:         else if(ch=='+') continue;
 197:         else if(ch!='\n') return(errno=F_ERRDCHR);
 198:     }
 199:     if(!dot)
 200:         for(i=0;i<d;i++) x /= 10;
 201:     for(i=0;i<ny;i++) y /= 10;
 202:     x=x+y;
 203:     if(sz)
 204:         for(i=0;i<z;i++) x /=10;
 205:     else    for(i=0;i<z;i++) x *= 10;
 206:     if(sx) x = -x;
 207:     if(!sawz)
 208:     {
 209:         for(i=scale;i>0;i--) x /= 10;
 210:         for(i=scale;i<0;i++) x *= 10;
 211:     }
 212:     if(len==sizeof(float)) p->pf=x;
 213:     else p->pd=x;
 214:     return(OK);
 215: }
 216: 
 217: rd_AW(p,w,len) char *p; ftnlen len;
 218: {   int i,ch;
 219:     if(w >= len)
 220:     {
 221:         for(i=0;i<w-len;i++) GET(ch);
 222:         for(i=0;i<len;i++)
 223:         {   GET(ch);
 224:             *p++=VAL(ch);
 225:         }
 226:     }
 227:     else
 228:     {
 229:         for(i=0;i<w;i++)
 230:         {   GET(ch);
 231:             *p++=VAL(ch);
 232:         }
 233:         for(i=0;i<len-w;i++) *p++=' ';
 234:     }
 235:     return(OK);
 236: }
 237: 
 238: #ifndef KOSHER
 239: /* THIS IS NOT ALLOWED IN THE NEW STANDARD 'CAUSE IT'S WEIRD */
 240: rd_H(n,s) char *s;
 241: {   int i,ch = 0;
 242:     for(i=0;i<n;i++)
 243:     {   if (ch != '\n')
 244:             GET(ch);
 245:         if (ch == '\n')
 246:             *s++ = ' ';
 247:         else
 248:             *s++ = ch;
 249:     }
 250:     return(OK);
 251: }
 252: 
 253: rd_POS(s) char *s;
 254: {   char quote;
 255:     int ch = 0;
 256:     quote = *s++;
 257:     while(*s)
 258:     {   if(*s==quote && *(s+1)!=quote)
 259:             break;
 260:         if (ch != '\n')
 261:             GET(ch);
 262:         if (ch == '\n')
 263:             *s++ = ' ';
 264:         else
 265:             *s++ = ch;
 266:     }
 267:     return(OK);
 268: }
 269: #endif	KOSHER

Defined functions

Defined macros