Return to io.c CVS log

Up to [Research Unix] / researchv10no / cmd / efl

Annotation of researchv10no/cmd/efl/io.c, revision 1.1

1.1     ! root        1: #include <ctype.h>
        !             2: 
        !             3: #include "defs"
        !             4: 
        !             5: static int lastfmtchar;
        !             6: static int writeop;
        !             7: static int needcomma;
        !             8: 
        !             9: 
        !            10: ptr mkiost(kwd,unit,list)
        !            11: int kwd;
        !            12: ptr unit;
        !            13: ptr list;
        !            14: {
        !            15: register ptr p;
        !            16: 
        !            17: if(unit!=NULL && unit->vtype!=TYINT)
        !            18:        {
        !            19:        execerr("I/O unit must be an integer", "");
        !            20:        return(NULL);
        !            21:        }
        !            22: p = allexpblock();
        !            23: p->tag = TIOSTAT;
        !            24: p->vtype = TYINT;
        !            25: p->iokwd = kwd;
        !            26: p->iounit = unit;
        !            27: p->iolist = list;
        !            28: 
        !            29: return(p);
        !            30: }
        !            31: 
        !            32: 
        !            33: 
        !            34: 
        !            35: struct iogroup *mkiogroup(list, format, dop)
        !            36: ptr list;
        !            37: char *format;
        !            38: ptr dop;
        !            39: {
        !            40: register struct iogroup *p;
        !            41: 
        !            42: p = ALLOC(iogroup);
        !            43: p->tag = TIOGROUP;
        !            44: p->doptr = (struct doblock *)dop;
        !            45: p->iofmt = format;
        !            46: p->ioitems = list;
        !            47: return(p);
        !            48: }
        !            49: 
        !            50: ptr exio(iostp, errhandle)
        !            51: struct iostblock *iostp;
        !            52: int errhandle;
        !            53: {
        !            54: ptr unit, list;
        !            55: int fmtlabel, errlabel, endlabel, jumplabel;
        !            56: ptr errval;
        !            57: int fmtio;
        !            58: 
        !            59: if(iostp == NULL)
        !            60:        return( errnode() );
        !            61: unit = iostp->iounit;
        !            62: list = iostp->iolist;
        !            63: 
        !            64: /* kwd=        0  binary input         2  formatted input
        !            65:        1  binary output        3  formatted output
        !            66: */
        !            67: 
        !            68: writeop = iostp->iokwd & 01;
        !            69: if( fmtio = (iostp->iokwd & 02) )
        !            70:        fmtlabel = nextlab() ;
        !            71: frexpblock(iostp);
        !            72: 
        !            73: errval = 0;
        !            74: endlabel = 0;
        !            75: if(errhandle)
        !            76:        {
        !            77:        switch(tailor.errmode)
        !            78:                {
        !            79:                default:
        !            80:                        execerr("no error handling ", "");
        !            81:                        return( errnode() );
        !            82: 
        !            83:                case IOERRIBM:  /* ibm: err=, end= */
        !            84:                        jumplabel = nextlab();
        !            85:                        break;
        !            86: 
        !            87:                case IOERRFORT77:       /* New Fortran Standard: iostat= */
        !            88:                        break;
        !            89: 
        !            90:                }
        !            91:        errval = gent(TYINT, PNULL);
        !            92:        }
        !            93: if(unit)
        !            94:        unit = simple(RVAL, unit);
        !            95: else   unit = mkint(writeop ? tailor.ftnout : tailor.ftnin);
        !            96: 
        !            97: if(unit->tag!=TCONST && (unit->tag!=TNAME || unit->vsubs!=0))
        !            98:        unit = simple(LVAL, mknode(TASGNOP,OPASGN,gent(TYINT,PNULL),unit));
        !            99: 
        !           100: simlist(list);
        !           101: 
        !           102: exlab(0);
        !           103: putic(ICKEYWORD, (writeop ? FWRITE : FREAD) );
        !           104: putic(ICOP, OPLPAR);
        !           105: prexpr(unit);
        !           106: frexpr(unit);
        !           107: 
        !           108: if( fmtio )
        !           109:        {
        !           110:        putic(ICOP, OPCOMMA);
        !           111:        putic(ICLABEL, fmtlabel);
        !           112:        }
        !           113: 
        !           114: if(errhandle) switch(tailor.errmode)
        !           115:        {
        !           116:        case IOERRIBM:
        !           117:                putic(ICOP,OPCOMMA);
        !           118:                putsii(ICCONST, "err =");
        !           119:                putic(ICLABEL, errlabel = nextlab() );
        !           120:                if(!writeop)
        !           121:                        {
        !           122:                        putic(ICOP,OPCOMMA);
        !           123:                        putsii(ICCONST, "end =");
        !           124:                        putic(ICLABEL, endlabel = nextlab() );
        !           125:                        }
        !           126:                break;
        !           127: 
        !           128:        case IOERRFORT77:
        !           129:                putic(ICOP,OPCOMMA);
        !           130:                putsii(ICCONST, "iostat =");
        !           131:                putname(errval);
        !           132:                break;
        !           133:        }
        !           134: 
        !           135: putic(ICOP,OPRPAR);
        !           136: putic(ICBLANK, 1);
        !           137: 
        !           138: needcomma = NO;
        !           139: doiolist(list);
        !           140: if(fmtio)
        !           141:        {
        !           142:        exlab(fmtlabel);
        !           143:        putic(ICKEYWORD, FFORMAT);
        !           144:        putic(ICOP, OPLPAR);
        !           145:        lastfmtchar = '(';
        !           146:        doformat(1, list);
        !           147:        putic(ICOP, OPRPAR);
        !           148:        }
        !           149: friolist(list);
        !           150: 
        !           151: if(errhandle && tailor.errmode==IOERRIBM)
        !           152:        {
        !           153:        exasgn(cpexpr(errval), OPASGN, mkint(0) );
        !           154:        exgoto(jumplabel);
        !           155:        exlab(errlabel);
        !           156:        exasgn(cpexpr(errval), OPASGN, mkint(1) );
        !           157:        if(endlabel)
        !           158:                {
        !           159:                exgoto(jumplabel);
        !           160:                exlab(endlabel);
        !           161:                exasgn(cpexpr(errval), OPASGN,
        !           162:                        mknode(TNEGOP,OPMINUS,mkint(1),PNULL) );
        !           163:                }
        !           164:        exlab(jumplabel);
        !           165:        }
        !           166: 
        !           167: return( errval );
        !           168: }
        !           169: 
        !           170: doiolist(list)
        !           171: ptr list;
        !           172: {
        !           173: register ptr p, q;
        !           174: register struct doblock *dop;
        !           175: for(p = list ; p ; p = p->nextp)
        !           176:        {
        !           177:        switch( ((struct headbits *)(q = p->datap))->tag)
        !           178:                {
        !           179:                case TIOGROUP:
        !           180:                        if(dop = q->doptr)
        !           181:                                {
        !           182:                                if(needcomma)
        !           183:                                        putic(ICOP, OPCOMMA);
        !           184:                                putic(ICOP, OPLPAR);
        !           185:                                needcomma = NO;
        !           186:                                }
        !           187:                        doiolist(q->ioitems);
        !           188:                        if(dop)
        !           189:                                {
        !           190:                                putic(ICOP,OPCOMMA);
        !           191:                                prexpr(dop->dovar);
        !           192:                                putic(ICOP, OPEQUALS);
        !           193:                                prexpr(dop->dopar[0]);
        !           194:                                putic(ICOP, OPCOMMA);
        !           195:                                prexpr(dop->dopar[1]);
        !           196:                                if(dop->dopar[2])
        !           197:                                        {
        !           198:                                        putic(ICOP, OPCOMMA);
        !           199:                                        prexpr(dop->dopar[2]);
        !           200:                                        }
        !           201:                                putic(ICOP, OPRPAR);
        !           202:                                needcomma = YES;
        !           203:                                }
        !           204:                        break;
        !           205: 
        !           206:                case TIOITEM:
        !           207:                        if(q->ioexpr)
        !           208:                                {
        !           209:                                if(needcomma)
        !           210:                                        putic(ICOP, OPCOMMA);
        !           211:                                prexpr(q->ioexpr);
        !           212:                                needcomma = YES;
        !           213:                                }
        !           214:                        break;
        !           215: 
        !           216:                default:
        !           217:                        badtag("doiolist", q->tag);
        !           218:                }
        !           219:        }
        !           220: }
        !           221: 
        !           222: doformat(nrep, list)
        !           223: int nrep;
        !           224: ptr list;
        !           225: {
        !           226: register ptr p, q;
        !           227: int k;
        !           228: ptr arrsize();
        !           229: 
        !           230: if(nrep > 1)
        !           231:        {
        !           232:        fmtnum(nrep);
        !           233:        fmtop(OPLPAR);
        !           234:        }
        !           235: 
        !           236: for(p = list ; p ; p = p->nextp)
        !           237:        switch( ((struct headbits *)(q = p->datap))->tag)
        !           238:                {
        !           239:                case TIOGROUP:
        !           240:                        if(q->iofmt)
        !           241:                                prfmt(q->nrep, q->iofmt);
        !           242:                        else    {
        !           243:                                doformat(q->nrep>0 ? q->nrep :
        !           244:                                        (q->doptr ? repfac(q->doptr) : 1),
        !           245:                                        q->ioitems);
        !           246:                                }
        !           247:                        break;
        !           248: 
        !           249:                case TIOITEM:
        !           250:                        if(q->iofmt == NULL)
        !           251:                                break;
        !           252: 
        !           253:                        if(q->nrep==0 && q->ioexpr && ((struct varblock *)q->ioexpr)->vdim)
        !           254:                                {
        !           255:                                if( ! isicon(arrsize(q->ioexpr), &k) )
        !           256:                                        execerr("io of adjustable array", "");
        !           257:                                else
        !           258:                                        prfmt(k, q->iofmt);
        !           259:                                }
        !           260:                        else
        !           261:                                prfmt(q->nrep, q->iofmt);
        !           262:                }
        !           263: if(nrep > 1)
        !           264:        fmtop(OPRPAR);
        !           265: }
        !           266: 
        !           267: fmtop(op)
        !           268: register int op;
        !           269: {
        !           270: register c;
        !           271: 
        !           272: c = (op==OPLPAR ? '(' : (op==OPRPAR ? ')' : 'x') );
        !           273: fmtcom(c);
        !           274: putic(ICOP, op);
        !           275: lastfmtchar = c;
        !           276: }
        !           277: 
        !           278: 
        !           279: 
        !           280: 
        !           281: fmtnum(k)
        !           282: int k;
        !           283: {
        !           284: fmtcom('1');
        !           285: prexpr( mkint(k) );
        !           286: lastfmtchar = ',';     /* prevent further comma after factor*/
        !           287: }
        !           288: 
        !           289: 
        !           290: 
        !           291: 
        !           292: 
        !           293: 
        !           294: 
        !           295: 
        !           296: /* separate formats with comma unless already a slash*/
        !           297: fmtcom(c)
        !           298: int c;
        !           299: {
        !           300: if( c!='/' && c!=')' && lastfmtchar!='/' && lastfmtchar!='(' && lastfmtchar!=',' )
        !           301:        {
        !           302:        putic(ICOP, OPCOMMA);
        !           303:        lastfmtchar = ',';
        !           304:        }
        !           305: }
        !           306: 
        !           307: prfmt(nrep, str)
        !           308: int nrep;
        !           309: char *str;
        !           310: {
        !           311: char fmt[20];
        !           312: register int k, k0, k1, k2;
        !           313: register char *t;
        !           314: 
        !           315: fmtcom(nrep>1 ? '1' : str[0]);
        !           316: 
        !           317: if(nrep > 1)
        !           318:        {
        !           319:        fmtnum(nrep);
        !           320:        fmtop(OPLPAR);
        !           321:        }
        !           322: 
        !           323: switch(str[0])
        !           324:        {
        !           325:        case 'd':
        !           326:        case 'e':
        !           327:        case 'g':
        !           328:                if(writeop)
        !           329:                        {
        !           330:                        putsii(ICCONST, "1p");
        !           331:                        break;
        !           332:                        }
        !           333:        
        !           334:        case 'f':
        !           335:                putsii(ICCONST, "0p");
        !           336:                break;
        !           337:                
        !           338:        case 'c':
        !           339:                k = convci(str+1);
        !           340:                k0 = tailor.ftnchwd;
        !           341:                k1 = k / k0;
        !           342:                k2 = k % k0;
        !           343:                if(k1>0 && k2>0)
        !           344:                        sprintf(fmt, "(%da%d,a%d)",k1,k0,k2);
        !           345:                else if(k1>1)
        !           346:                        sprintf(fmt, "(%da%d)", k1, k0);
        !           347:                else    sprintf(fmt, "a%d", k);
        !           348:                putsii(ICCONST, fmt);
        !           349:                lastfmtchar = 'f';      /* last char isnt operator */
        !           350:                goto close;
        !           351: 
        !           352:        default:
        !           353:                break;
        !           354:        }
        !           355: putsii(ICCONST,str);
        !           356: /* if the format is an nH, act as if it ended with a non-operator character */
        !           357: if( isdigit(str[0]) )
        !           358:        {
        !           359:        for(t = str+1 ; isdigit(*t) ; ++t);
        !           360:                ;
        !           361:        if(*t=='h' || *t=='H')
        !           362:                {
        !           363:                lastfmtchar = 'f';
        !           364:                goto close;
        !           365:                }
        !           366:        }
        !           367: lastfmtchar = str[ strlen(str)-1 ];
        !           368: 
        !           369: close:
        !           370:        if(nrep > 1)
        !           371:                fmtop(OPRPAR);
        !           372: }
        !           373: 
        !           374: friolist(list)
        !           375: ptr list;
        !           376: {
        !           377: register ptr p, q;
        !           378: register struct doblock *dop;
        !           379: 
        !           380: for(p = list; p; p = p->nextp)
        !           381:        {
        !           382:        switch ( ((struct headbits *)(q = p->datap))->tag)
        !           383:                {
        !           384:                case TIOGROUP:
        !           385:                        if(dop = q->doptr)
        !           386:                                {
        !           387:                                frexpr(dop->dovar);
        !           388:                                frexpr(dop->dopar[0]);
        !           389:                                frexpr(dop->dopar[1]);
        !           390:                                if(dop->dopar[2])
        !           391:                                        frexpr(dop->dopar[2]);
        !           392:                                cfree(dop);
        !           393:                                }
        !           394:                        friolist(q->ioitems);
        !           395:                        break;
        !           396: 
        !           397:                case TIOITEM:
        !           398:                        if(q->ioexpr)
        !           399:                                frexpr(q->ioexpr);
        !           400:                        break;
        !           401: 
        !           402:                default:
        !           403:                        badtag("friolist", q->tag);
        !           404:                }
        !           405:        if(q->iofmt)
        !           406:                cfree(q->iofmt);
        !           407:        cfree(q);
        !           408:        }
        !           409: frchain( &list );
        !           410: }
        !           411: 
        !           412: simlist(p)
        !           413: register ptr p;
        !           414: {
        !           415: register ptr q, ep;
        !           416: struct iogroup *enloop();
        !           417: 
        !           418: for( ; p ; p = p->nextp)
        !           419:        switch( ((struct headbits *)(q = p->datap))->tag )
        !           420:                {
        !           421:                case TIOGROUP:
        !           422:                        simlist(q->ioitems);
        !           423:                        break;
        !           424: 
        !           425:                case TIOITEM:
        !           426:                        if(ep = q->ioexpr)
        !           427:                                {
        !           428:                                /* if element is a subaggregate, need
        !           429:                                   an implied do loop */
        !           430:                                if( (ep->voffset || ep->vsubs) &&
        !           431:                                    (ep->vdim || ep->vtypep) )
        !           432:                                        p->datap = (int *)enloop(q);
        !           433:                                else
        !           434:                                        q->ioexpr = simple(LVAL,ep);
        !           435:                                }
        !           436:                        break;
        !           437: 
        !           438:                default:
        !           439:                        badtag("ioblock", q->tag);
        !           440:                }
        !           441: }
        !           442: 
        !           443: 
        !           444: 
        !           445: 
        !           446: /* replace an aggregate by an implied do loop of elements */
        !           447: 
        !           448: struct iogroup *enloop(p)
        !           449: struct ioitem *p;
        !           450: {
        !           451: register struct doblock *dop;
        !           452: struct iogroup *gp;
        !           453: ptr np, q, v, arrsize(), mkioitem();
        !           454: int nrep, k, nwd;
        !           455: 
        !           456: q = p->ioexpr;
        !           457: np = arrsize(q);
        !           458: if( ! isicon(np, &nrep) )
        !           459:        nrep = 0;
        !           460: 
        !           461: if(q->vtype == TYCHAR)
        !           462:        {
        !           463:        nwd = ceil(conval(q->vtypep), tailor.ftnchwd);
        !           464:        if(nwd != 1)
        !           465:                np = simple(LVAL, mknode(TAROP,OPSTAR,np,mkint(nwd)));
        !           466:        }
        !           467: /* else
        !           468:        nwd = 0; */
        !           469: 
        !           470: if( isicon(np, &k) && k==1)
        !           471:        return((struct iogroup *)p);
        !           472: 
        !           473: dop = ALLOC(doblock);
        !           474: dop->tag = TDOBLOCK;
        !           475: 
        !           476: dop->dovar = v = gent(TYINT, PNULL);
        !           477: dop->dopar[0] = mkint(1);
        !           478: dop->dopar[1] = simple(SUBVAL, np);
        !           479: dop->dopar[2] = NULL;
        !           480: 
        !           481: q = simple(LVAL, q);
        !           482: if(q->vsubs == NULL)
        !           483:        q->vsubs = mknode(TLIST,0, mkchain(cpexpr(v),CHNULL), PNULL);
        !           484: else
        !           485:        ((chainp)((struct exprblock *)q->vsubs)->leftp)->datap = simple(SUBVAL, mknode(TAROP,OPPLUS, cpexpr(v),
        !           486:                     mknode(TAROP,OPMINUS,((chainp)((struct exprblock *)q->vsubs)->leftp)->datap,mkint(1))));
        !           487: q->vdim = NULL;
        !           488: gp = mkiogroup( mkchain(mkioitem(q,CNULL), CHNULL), p->iofmt, dop);
        !           489: gp->nrep = nrep;
        !           490: cfree(p);
        !           491: return(gp);
        !           492: }
        !           493: 
        !           494: ptr mkformat(letter, n1, n2)
        !           495: char letter;
        !           496: register ptr n1, n2;
        !           497: {
        !           498: char f[20], *fp, *s;
        !           499: int k;
        !           500: 
        !           501: if(letter == 's')
        !           502:        {
        !           503:        if(n1)
        !           504:                {
        !           505:                k = conval(n1);
        !           506:                frexpr(n1);
        !           507:                }
        !           508:        else    k = 1;
        !           509: 
        !           510:        for(fp = f; k-->0 ; )
        !           511:                *fp++ = '/';
        !           512:        *fp = '\0';
        !           513:        return( (int *)copys(f) );
        !           514:        }
        !           515: 
        !           516: f[0] = letter;
        !           517: fp = f+1;
        !           518: 
        !           519: if(n1) {
        !           520:        n1 = simple(RVAL,n1);
        !           521:        if(n1->tag==TCONST && n1->vtype==TYINT)
        !           522:                {
        !           523:                for(s = (char *)n1->leftp ; *s; )
        !           524:                        *fp++ = *s++;
        !           525:                }
        !           526:        else    execerr("bad format component %s", n1->leftp);
        !           527:        frexpr(n1);
        !           528:        }
        !           529: 
        !           530: if(n2) {
        !           531:        if(n2->tag==TCONST && n2->vtype==TYINT)
        !           532:                {
        !           533:                *fp++ = '.';
        !           534:                for(s = (char *)n2->leftp ; *s; )
        !           535:                        *fp++ = *s++;
        !           536:                }
        !           537:        else    execerr("bad format component %s", n2->leftp);
        !           538:        frexpr(n2);
        !           539:        }
        !           540: 
        !           541: if( letter == 'x' )
        !           542:        {
        !           543:        if(n1 == 0)
        !           544:                *fp++ = '1';
        !           545:        fp[0] = 'x';
        !           546:        fp[1] = '\0';
        !           547:        return( (int *)copys(f+1) );
        !           548:        }
        !           549: else   {
        !           550:        *fp = '\0';
        !           551:        return( (int *)copys(f) );
        !           552:        }
        !           553: }
        !           554: 
        !           555: ptr mkioitem(e,f)
        !           556: register ptr e;
        !           557: char *f;
        !           558: {
        !           559: register ptr p;
        !           560: char fmt[10];
        !           561: ptr gentemp();
        !           562: 
        !           563: p = (int *)ALLOC(ioitem);
        !           564: p->tag = TIOITEM;
        !           565: if(e!=NULL && e->tag==TCONST)
        !           566:        if(e->vtype==TYCHAR && (f==0 || (f[0]=='c' && f[1]=='\0') ))
        !           567:                {
        !           568:                p->ioexpr = 0;
        !           569:                sprintf(msg, "%dh%s", strlen(e->leftp), e->leftp);
        !           570:                p->iofmt = copys(msg);
        !           571:                frexpr(e);
        !           572:                return(p);
        !           573:                }
        !           574:        else    e = mknode(TASGNOP,OPASGN,gentemp(e),e);
        !           575: 
        !           576: if(e && e->vtype==TYCHAR && f && f[0]=='c' && f[1]=='\0')
        !           577:        f = NULL;
        !           578: if(f == NULL)
        !           579:        {
        !           580:        switch(e->vtype)
        !           581:                {
        !           582:                case TYINT:
        !           583:                case TYREAL:
        !           584:                case TYLREAL:
        !           585:                case TYCOMPLEX:
        !           586:                case TYLOG:
        !           587:                        f = copys( tailor.dfltfmt[e->vtype] );
        !           588:                        break;
        !           589: 
        !           590:                case TYCHAR:
        !           591:                        if(((struct headbits *)e->vtypep)->tag != TCONST)
        !           592:                                {
        !           593:                                execerr("no adjustable character formats", "");
        !           594:                                f = 0;
        !           595:                                }
        !           596:                        else    {
        !           597:                                sprintf(fmt, "c%s", ((struct exprblock *)e->vtypep)->leftp);
        !           598:                                f = copys(fmt);
        !           599:                                }
        !           600:                        break;
        !           601: 
        !           602:                default:
        !           603:                        execerr("cannot do I/O on structures", "");
        !           604:                        f = 0;
        !           605:                        break;
        !           606:                }
        !           607:        }
        !           608: 
        !           609: p->ioexpr = e;
        !           610: p->iofmt = f;
        !           611: return(p);
        !           612: }
        !           613: 
        !           614: 
        !           615: 
        !           616: ptr arrsize(p)
        !           617: ptr p;
        !           618: {
        !           619: register ptr b;
        !           620: ptr f, q;
        !           621: 
        !           622: q = mkint(1);
        !           623: 
        !           624: if(b = p->vdim)
        !           625:     for(b = b->datap ; b ; b = b->nextp)
        !           626:        {
        !           627:        if(b->upperb == 0) continue;
        !           628:        f = cpexpr(b->upperb);
        !           629:        if(b->lowerb)
        !           630:                f = mknode(TAROP,OPPLUS,f,
        !           631:                        mknode(TAROP,OPMINUS,mkint(1),cpexpr(b->lowerb)));
        !           632:        q = simple(RVAL, mknode(TAROP,OPSTAR,q,f));
        !           633:        }
        !           634: return(q);
        !           635: }
        !           636: 
        !           637: 
        !           638: 
        !           639: 
        !           640: repfac(dop)
        !           641: register struct doblock *dop;
        !           642: {
        !           643: int m1, m2, m3;
        !           644: 
        !           645: m3 = 1;
        !           646: if( isicon(dop->dopar[0],&m1) &&  isicon(dop->dopar[1],&m2) &&
        !           647:   (dop->dopar[2]==NULL || isicon(dop->dopar[2],&m3)) )
        !           648:        {
        !           649:        if(m3 > 0)
        !           650:                return(1 + (m2-m1)/m3);
        !           651:        }
        !           652: else   execerr("nonconstant implied do", "");
        !           653: return(1);
        !           654: }
        !           655: 
        !           656: 
        !           657: 
        !           658: ioop(s)
        !           659: char *s;
        !           660: {
        !           661: if( equals(s, "backspace") )
        !           662:        return(FBACKSPACE);
        !           663: if( equals(s, "rewind") )
        !           664:        return(FREWIND);
        !           665: if( equals(s, "endfile") )
        !           666:        return(FENDFILE);
        !           667: return(0);
        !           668: }
        !           669: 
        !           670: 
        !           671: 
        !           672: 
        !           673: ptr exioop(p, errcheck)
        !           674: register struct exprblock *p;
        !           675: int errcheck;
        !           676: {
        !           677: register ptr q, t;
        !           678: 
        !           679: if( (q = p->rightp)==NULL || (q = q->leftp)==NULL  )
        !           680:        {
        !           681:        execerr("bad I/O operation", "");
        !           682:        return(NULL);
        !           683:        }
        !           684: q = simple(LVAL, cpexpr(q->datap) );
        !           685: 
        !           686: exlab(0);
        !           687: putic(ICKEYWORD, ioop(((struct stentry *)((struct typeblock *)p->leftp)->sthead)->namep));
        !           688: 
        !           689: if(errcheck)
        !           690:        {
        !           691:        if(tailor.errmode != IOERRFORT77)
        !           692:                {
        !           693:                execerr("cannot test value of IOOP without ftn77", "");
        !           694:                return( errnode() );
        !           695:                }
        !           696:        putic(ICOP, OPLPAR);
        !           697:        prexpr(q);
        !           698:        putic(ICOP, OPCOMMA);
        !           699:        putsii(ICCONST, "iostat =");
        !           700:        prexpr(cpexpr( t = gent(TYINT,PNULL)));
        !           701:        putic(ICOP, OPRPAR);
        !           702:        return( t );
        !           703:        }
        !           704: else   {
        !           705:        putic(ICBLANK, 1);
        !           706:        prexpr(q);
        !           707:        }
        !           708: return 0;
        !           709: }

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