Return to lread.c CVS log

Up to [CSRG BSD Unix] / 43BSDTahoe / usr.lib / libI77

Annotation of 43BSDTahoe/usr.lib/libI77/lread.c, revision 1.1

1.1     ! root        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: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.