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

#### Defined functions

e_rsle defined in line 81; never used
get_repet defined in line 194; used 3 times

- in line 299, 319, 353

l_C defined in line 295; used 1 times

- in line 115

l_CHAR defined in line 348; used 1 times

- in line 121

l_L defined in line 314; used 1 times

- in line 118

l_R defined in line 213; used 3 times

- in line 111, 304-307(2)

l_read defined in line 89; used 2 times

- in line 35, 58

lr_comm defined in line 175; used 4 times

- in line 223, 298, 318, 352

nullfld defined in line 422; used 4 times

- in line 229, 300, 320, 354

rd_int defined in line 278; used 7 times

- in line 200, 224, 230, 241-246(2), 254-257(2)

s_rsle defined in line 49; never used
t_getc defined in line 68; used 2 times

- in line 35, 59

t_sep defined in line 405; used 2 times

- in line 102, 306

#### Defined variables

lchar defined in line 32; used 9 times

- in line 166, 366-369(4), 379-381(4)

lrd defined in line 31; used 7 times

- in line 64, 95, 129-134(3), 369, 380

ltab defined in line 37; used 6 times

- in line 22-27(6)

ltype defined in line 34; used 7 times

- in line 63, 135, 179, 274, 310, 341, 365

lx defined in line 33; used 13 times

- in line 138-163(8), 273, 305, 326-335(3)

ly defined in line 33; used 3 times

- in line 157-162(2), 305

#### Defined macros

AP defined in line 18; used 4 times

- in line 24, 39-41(3)

B defined in line 17; used 4 times

- in line 22, 39-41(3)

BUFSIZE defined in line 347; used 3 times

- in line 367-368(2), 378

D defined in line 20; used 11 times

- in line 26, 42(10)

EIN defined in line 21; used 4 times

- in line 27, 38-41(3)

EX defined in line 19; used 5 times

- in line 25, 43-45(4)

GETC defined in line 29; used 26 times

- in line 85, 98, 126-128(2), 180, 198-202(2), 225, 244(2), 253, 282-285(2), 301-302(2), 308, 321(2), 342, 355, 371-372(2), 393, 409, 416, 427

SP defined in line 16; used 5 times

- in line 23, 39-41(4)

endlinp defined in line 27; used 4 times

- in line 127, 342, 372, 429

isapos defined in line 24; used 1 times

- in line 355

isblnk defined in line 22; used 6 times

- in line 98, 180, 302, 308, 409, 416

isdigit defined in line 26; used 3 times

- in line 198, 244, 285

isexp defined in line 25; used 1 times

- in line 253

issep defined in line 23; used 7 times

- in line 127, 333, 342, 356, 372, 416, 429

Last modified: 1987-02-18 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 1377 |