lread.c

Functions

e_rsle            X
get_repet         X
l_C               X
l_CHAR            X
l_L               X
l_R               X
l_read            X
lr_comm           X
nullfld           X
rd_int            X
s_rsle            X
t_getc            X
t_sep             X

Variables

lchar             X
lrd               X
ltab              X
ltype             X
lx                X
ly                X

Macros

AP                X
B                 X
BUFSIZE           X
D                 X
EIN               X
EX                X
GETC              X
SP                X
endlinp           X
isapos            X
isblnk            X
isdigit           X
isexp             X
issep             X

   1: /*
   2: char id_lread[] = "@(#)lread.c	1.7";
   3:  *
   4:  * list directed read
   5:  */
   6: 
   7: #include "fio.h"
   8: #include "lio.h"
   9: 
  10: #define SP 1
  11: #define B  2
  12: #define AP 4
  13: #define EX 8
  14: #define D 16
  15: #define EIN 32
  16: #define isblnk(x)   (ltab[x+1]&B)
  17: #define issep(x)    (ltab[x+1]&SP)
  18: #define isapos(x)   (ltab[x+1]&AP)
  19: #define isexp(x)    (ltab[x+1]&EX)
  20: #define isdigit(x)  (ltab[x+1]&D)
  21: #define endlinp(x)  (ltab[x+1]&EIN)
  22: 
  23: #define GETC(x) (x=(*getn)())
  24: 
  25: char lrd[] = "list read";
  26: char *lchar;
  27: double lx,ly;
  28: int ltype;
  29: int l_read(),t_getc(),ungetc();
  30: 
  31: char ltab[128+1] =
  32: {       EIN, /* offset one for EOF */
  33: /*   0- 15 */   0,0,AP,0,0,0,0,0,0,B,SP|B|EIN,0,0,0,0,0, /* ^B,TAB,NEWLINE */
  34: /*  16- 31 */   0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  35: /*  32- 47 */   SP|B,0,AP,0,0,0,0,AP,0,0,0,0,SP,0,0,EIN, /* space,",',comma,/ */
  36: /*  48- 63 */   D,D,D,D,D,D,D,D,D,D,0,0,0,0,0,0,    /* digits 0-9 */
  37: /*  64- 79 */   0,0,0,0,EX,EX,0,0,0,0,0,0,0,0,0,0,  /* D,E */
  38: /*  80- 95 */   0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  39: /*  96-111 */   0,0,0,0,EX,EX,0,0,0,0,0,0,0,0,0,0,  /* d,e */
  40: /* 112-127 */   0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  41: };
  42: 
  43: s_rsle(a) cilist *a;    /* start read sequential list external */
  44: {
  45:     int n;
  46:     reading = YES;
  47:     if(n=c_le(a,READ)) return(n);
  48:     l_first = YES;
  49:     lquit = NO;
  50:     lioproc = l_read;
  51:     getn = t_getc;
  52:     ungetn = ungetc;
  53:     leof = curunit->uend;
  54:     lcount = 0;
  55:     ltype = NULL;
  56:     if(curunit->uwrt && ! nowreading(curunit)) err(errflag, errno, lrd)
  57:     return(OK);
  58: }
  59: 
  60: t_getc()
  61: {   int ch;
  62:     if(curunit->uend) return(EOF);
  63:     if((ch=getc(cf))!=EOF) return(ch);
  64:     if(feof(cf))
  65:     {   curunit->uend = YES;
  66:         leof = EOF;
  67:     }
  68:     else clearerr(cf);
  69:     return(EOF);
  70: }
  71: 
  72: e_rsle()
  73: {
  74:     int ch;
  75:     if(curunit->uend) return(OK);
  76:     while(GETC(ch) != '\n' && ch != EOF);
  77:     return(OK);
  78: }
  79: 
  80: l_read(number,ptr,len,type) ftnint *number,type; flex *ptr; ftnlen len;
  81: {   int i,n,ch;
  82:     double *yy;
  83:     float *xx;
  84:     for(i=0;i<*number;i++)
  85:     {
  86:         if(leof) err(endflag, EOF, lrd)
  87:         if(l_first)
  88:         {   l_first = NO;
  89:             while(isblnk(GETC(ch)));    /* skip blanks */
  90:             (*ungetn)(ch,cf);
  91:         }
  92:         else if(lcount==0)      /* repeat count == 0 ? */
  93:         {   ERR(t_sep());  /* look for non-blank, allow 1 comma */
  94:             if(lquit) return(OK);   /* slash found */
  95:         }
  96:         switch((int)type)
  97:         {
  98:         case TYSHORT:
  99:         case TYLONG:
 100:         case TYREAL:
 101:         case TYDREAL:
 102:             ERR(l_R(1));
 103:             break;
 104:         case TYCOMPLEX:
 105:         case TYDCOMPLEX:
 106:             ERR(l_C());
 107:             break;
 108:         case TYLOGICAL:
 109:             ERR(l_L());
 110:             break;
 111:         case TYCHAR:
 112:             ERR(l_CHAR());
 113:             break;
 114:         }
 115:         if(lquit) return(OK);
 116:         if(leof) err(endflag,EOF,lrd)
 117:         else if(external && ferror(cf)) err(errflag,errno,lrd)
 118:         if(ltype) switch((int)type)
 119:         {
 120:         case TYSHORT:
 121:             ptr->flshort=lx;
 122:             break;
 123:         case TYLOGICAL:
 124:         case TYLONG:
 125:             ptr->flint=lx;
 126:             break;
 127:         case TYREAL:
 128:             ptr->flreal=lx;
 129:             break;
 130:         case TYDREAL:
 131:             ptr->fldouble=lx;
 132:             break;
 133:         case TYCOMPLEX:
 134:             xx=(float *)ptr;
 135:             *xx++ = ly;
 136:             *xx = lx;
 137:             break;
 138:         case TYDCOMPLEX:
 139:             yy=(double *)ptr;
 140:             *yy++ = ly;
 141:             *yy = lx;
 142:             break;
 143:         case TYCHAR:
 144:             b_char(lchar,(char *)ptr,len);
 145:             break;
 146:         }
 147:         if(lcount>0) lcount--;
 148:         ptr = (flex *)((char *)ptr + len);
 149:     }
 150:     return(OK);
 151: }
 152: 
 153: lr_comm()
 154: {   int ch;
 155:     if(lcount) return(lcount);
 156:     ltype=NULL;
 157:     while(isblnk(GETC(ch)));
 158:     (*ungetn)(ch,cf);
 159:     if(ch==',')
 160:     {   lcount=1;
 161:         return(lcount);
 162:     }
 163:     if(ch=='/')
 164:     {   lquit = YES;
 165:         return(lquit);
 166:     }
 167:     else
 168:         return(OK);
 169: }
 170: 
 171: get_repet()
 172: {   char ch;
 173:     double lc;
 174:     if(isdigit(GETC(ch)))
 175:     {   (*ungetn)(ch,cf);
 176:         rd_int(&lc);
 177:         lcount = (int)lc;
 178:         if(GETC(ch)!='*')
 179:             if(leof) return(EOF);
 180:             else return(F_ERREPT);
 181:     }
 182:     else
 183:     {   lcount = 1;
 184:         (*ungetn)(ch,cf);
 185:     }
 186:     return(OK);
 187: }
 188: 
 189: l_R(flg) int flg;
 190: {   double a,b,c,d;
 191:     int da,db,dc,dd;
 192:     int i,ch,sign=0;
 193:     a=b=c=d=0;
 194:     da=db=dc=dd=0;
 195:     if(flg && lr_comm()) return(OK);
 196:     da=rd_int(&a);  /* repeat count ? */
 197:     if(GETC(ch)=='*')
 198:     {
 199:         if (a <= 0.) return(F_ERNREP);
 200:         lcount=(int)a;
 201:         if (nullfld()) return(OK);  /* could be R* */
 202:         db=rd_int(&b);  /* whole part of number */
 203:     }
 204:     else
 205:     {   (*ungetn)(ch,cf);
 206:         db=da;
 207:         b=a;
 208:         lcount=1;
 209:     }
 210:     if(GETC(ch)=='.' && isdigit(GETC(ch)))
 211:     {   (*ungetn)(ch,cf);
 212:         dc=rd_int(&c);  /* fractional part of number */
 213:     }
 214:     else
 215:     {   (*ungetn)(ch,cf);
 216:         dc=0;
 217:         c=0.;
 218:     }
 219:     if(isexp(GETC(ch)))
 220:         dd=rd_int(&d);  /* exponent */
 221:     else if (ch == '+' || ch == '-')
 222:     {   (*ungetn)(ch,cf);
 223:         dd=rd_int(&d);
 224:     }
 225:     else
 226:     {   (*ungetn)(ch,cf);
 227:         dd=0;
 228:     }
 229:     if(db<0 || b<0)
 230:     {   sign=1;
 231:         b = -b;
 232:     }
 233:     for(i=0;i<dc;i++) c/=10.;
 234:     b=b+c;
 235:     if (dd > 0)
 236:     {   for(i=0;i<d;i++) b *= 10.;
 237:         for(i=0;i< -d;i++) b /= 10.;
 238:     }
 239:     lx=sign?-b:b;
 240:     ltype=TYLONG;
 241:     return(OK);
 242: }
 243: 
 244: rd_int(x) double *x;
 245: {   int ch,sign=0,i=0;
 246:     double y=0.0;
 247:     if(GETC(ch)=='-') sign = -1;
 248:     else if(ch=='+') sign=0;
 249:     else (*ungetn)(ch,cf);
 250:     while(isdigit(GETC(ch)))
 251:     {   i++;
 252:         y=10*y + ch-'0';
 253:     }
 254:     (*ungetn)(ch,cf);
 255:     if(sign) y = -y;
 256:     *x = y;
 257:     return(y==0.0?sign:i); /* 0:[+]&&y==0, -1:-&&y==0, >0:#digits&&y!=0 */
 258: }
 259: 
 260: l_C()
 261: {   int ch,n;
 262:     if(lr_comm()) return(OK);
 263:     if(n=get_repet()) return(n);        /* get repeat count */
 264:     if (nullfld()) return(OK);      /* could be R* */
 265:     if(GETC(ch)!='(') err(errflag,F_ERLIO,"no (")
 266:     while(isblnk(GETC(ch)));
 267:     (*ungetn)(ch,cf);
 268:     l_R(0);     /* get real part */
 269:     ly = lx;
 270:     if(t_sep()) return(EOF);
 271:     l_R(0);     /* get imag part */
 272:     while(isblnk(GETC(ch)));
 273:     if(ch!=')') err(errflag,F_ERLIO,"no )")
 274:     ltype = TYCOMPLEX;
 275:     return(OK);
 276: }
 277: 
 278: l_L()
 279: {
 280:     int ch,n;
 281:     if(lr_comm()) return(OK);
 282:     if(n=get_repet()) return(n);        /* get repeat count */
 283:     if (nullfld()) return(OK);      /* could be R* */
 284:     if(GETC(ch)=='.') GETC(ch);
 285:     switch(ch)
 286:     {
 287:     case 't':
 288:     case 'T':
 289:         lx=1;
 290:         break;
 291:     case 'f':
 292:     case 'F':
 293:         lx=0;
 294:         break;
 295:     default:
 296:         if(isblnk(ch) || issep(ch))
 297:         {   (*ungetn)(ch,cf);
 298:             lx=0;
 299:             return(OK);
 300:         }
 301:         else if(ch==EOF) return(EOF);
 302:         else    err(errflag,F_ERLIO,"logical not T or F");
 303:     }
 304:     ltype=TYLOGICAL;
 305:     while(!issep(GETC(ch)) && !isblnk(ch) && !endlinp(ch));
 306:     (*ungetn)(ch,cf);
 307:     return(OK);
 308: }
 309: 
 310: #define BUFSIZE 128
 311: l_CHAR()
 312: {   int ch,size,i,n;
 313:     char quote,*p;
 314:     if(lr_comm()) return(OK);
 315:     if(n=get_repet()) return(n);        /* get repeat count */
 316:     if (nullfld()) return(OK);      /* could be R* */
 317:     if(isapos(GETC(ch))) quote=ch;
 318:     else if(isblnk(ch) || issep(ch) || ch==EOF || ch=='\n')
 319:     {   if(ch==EOF) return(EOF);
 320:         (*ungetn)(ch,cf);
 321:         return(OK);
 322:     }
 323:     else
 324:     {   quote = '\0';   /* to allow single word non-quoted */
 325:         (*ungetn)(ch,cf);
 326:     }
 327:     ltype=TYCHAR;
 328:     if(lchar!=NULL) free(lchar);
 329:     size=BUFSIZE-1;
 330:     p=lchar=(char *)malloc(BUFSIZE);
 331:     if(lchar==NULL) err(errflag,F_ERSPACE,lrd)
 332:     for(i=0;;)
 333:     {   while( ( (quote && GETC(ch)!=quote) ||
 334:             (!quote && !issep(GETC(ch)) && !isblnk(ch) && !endlinp(ch)) )
 335:             && ch!='\n' && ch!=EOF && ++i<size )
 336:                 *p++ = ch;
 337:         if(i==size)
 338:         {
 339:         newone:
 340:             size += BUFSIZE;
 341:             lchar=(char *)realloc(lchar, size+1);
 342:             if(lchar==NULL) err(errflag,F_ERSPACE,lrd)
 343:             p=lchar+i-1;
 344:             *p++ = ch;
 345:         }
 346:         else if(ch==EOF) return(EOF);
 347:         else if(ch=='\n')
 348:         {   if(*(p-1) == '\\') *(p-1) = ch;
 349:             else if(!quote)
 350:             {   *p = '\0';
 351:                 (*ungetn)(ch,cf);
 352:                 return(OK);
 353:             }
 354:         }
 355:         else if(quote && GETC(ch)==quote)
 356:         {   if(++i<size) *p++ = ch;
 357:             else goto newone;
 358:         }
 359:         else
 360:         {   (*ungetn)(ch,cf);
 361:             *p = '\0';
 362:             return(OK);
 363:         }
 364:     }
 365: }
 366: 
 367: t_sep()
 368: {
 369:     int ch;
 370:     while(isblnk(GETC(ch)));
 371:     if(leof) return(EOF);
 372:     if(ch=='/')
 373:     {   lquit = YES;
 374:         (*ungetn)(ch,cf);
 375:         return(OK);
 376:     }
 377:     if(issep(ch)) while(isblnk(GETC(ch)));
 378:     if(leof) return(EOF);
 379:     (*ungetn)(ch,cf);
 380:     return(OK);
 381: }
 382: 
 383: nullfld()   /* look for null field following a repeat count */
 384: {
 385:     int ch;
 386: 
 387:     while(isblnk(GETC(ch)));
 388:     (*ungetn)(ch,cf);
 389:     if (issep(ch) || endlinp(ch))
 390:         return(YES);
 391:     return(NO);
 392: }

Defined functions

e_rsle defined in line 72; never used

get_repet defined in line 171; used 3 times

in line 263, 282, 315

l_C defined in line 260; used 1 times

in line 106

l_CHAR defined in line 311; used 1 times

in line 112

l_L defined in line 278; used 1 times

in line 109

l_R defined in line 189; used 3 times

in line 102, 268-271(2)

l_read defined in line 80; used 4 times

in line 29, 50
in /usr/src/lib/libI77/riio.c line 11, 77

lr_comm defined in line 153; used 4 times

in line 195, 262, 281, 314

nullfld defined in line 383; used 4 times

in line 201, 264, 283, 316

rd_int defined in line 244; used 6 times

in line 176, 196, 202, 212, 220-223(2)

s_rsle defined in line 43; never used

t_getc defined in line 60; used 2 times

in line 29, 51

t_sep defined in line 367; used 2 times

in line 93, 270

Defined variables

lchar defined in line 26; used 9 times

in line 144, 328-331(4), 341-343(4)

lrd defined in line 25; used 6 times

in line 56, 86, 116-117(2), 331, 342

ltab defined in line 31; used 6 times

in line 16-21(6)

ltype defined in line 28; used 7 times

in line 55, 118, 156, 240, 274, 304, 327

lx defined in line 27; used 11 times

in line 121-141(6), 239, 269, 289-298(3)

ly defined in line 27; used 3 times

in line 135-140(2), 269

Defined macros

AP defined in line 12; used 4 times

in line 18, 33-35(3)

B defined in line 11; used 4 times

in line 16, 33-35(3)

BUFSIZE defined in line 310; used 3 times

in line 329-330(2), 340

D defined in line 14; used 11 times

in line 20, 36(10)

EIN defined in line 15; used 4 times

in line 21, 32-35(3)

EX defined in line 13; used 5 times

in line 19, 37-39(4)

GETC defined in line 23; used 24 times

in line 76, 89, 157, 174-178(2), 197, 210(2), 219, 247-250(2), 265-266(2), 272, 284(2), 305, 317, 333-334(2), 355, 370, 377, 387

SP defined in line 10; used 4 times

in line 17, 33-35(3)

endlinp defined in line 21; used 3 times

in line 305, 334, 389

isapos defined in line 18; used 1 times

in line 317

isblnk defined in line 16; used 11 times

in line 89, 157, 266, 272, 296, 305, 318, 334, 370, 377, 387

isdigit defined in line 20; used 3 times

in line 174, 210, 250

isexp defined in line 19; used 1 times

in line 219

issep defined in line 17; used 6 times

in line 296, 305, 318, 334, 377, 389

Last modified: 1983-05-20
Generated: 2016-12-26

Generated by src2html V0.67
page hit count: 1498