# 2.11BSD#431 - /usr/src/usr.bin/f77/io.c

##### Functions

    dofclose          X
    dofinquire        X
    dofmove           X
    dofopen           X
    doio              X
    doiolist          X
    endio             X
    endioctl          X
    fmtstmt           X
    ioclause          X
    iocname           X
    ioset             X
    iosetc            X
    iosetecdc         X
    iosetip           X
    iosetlc           X
    putio             X
    putiocall         X
    setfmt            X
    startioctl        X
    startrw           X

##### Variables

    ioc               X
    ioecdc            X
    ioendlab          X
    ioerrlab          X
    ioformatted       X
    ioroutine         X
    iosreturn         X
    iostest           X
    jumplab           X
    skiplab           X

##### Macros

    FORMATTED         X
    IOALL             X
    IOSACCESS         X
    IOSBLANK          X
    IOSDIRECT         X
    IOSEND            X
    IOSERR            X
    IOSEXISTS         X
    IOSFILE           X
    IOSFMT            X
    IOSFORM           X
    IOSFORMATTED      X
    IOSIOSTAT         X
    IOSNAME           X
    IOSNAMED          X
    IOSNEXTREC        X
    IOSNUMBER         X
    IOSOPENED         X
    IOSREC            X
    IOSRECL           X
    IOSRETURN         X
    IOSRW             X
    IOSSEQUENTIAL     X
    IOSSTATUS         X
    IOSTP             X
    IOSUNFORMATTED    X
    IOSUNIT           X
    LISTDIRECTED      X
    MAXIO             X
    NIOS              X
    SZFLAG            X
    SZIOINT           X
    TYIOINT           X
    UNFORMATTED       X
    V                 X
    XACCESS           X
    XBLANK            X
    XCLSTATUS         X
    XDIRECT           X
    XDIRLEN           X
    XEND              X
    XERR              X
    XEXISTS           X
    XFILE             X
    XFILELEN          X
    XFMT              X
    XFMTED            X
    XFMTEDLEN         X
    XFNAME            X
    XFNAMELEN         X
    XFORM             X
    XFORMATTED        X
    XFORMLEN          X
    XIEND             X
    XIERR             X
    XIFMT             X
    XIREC             X
    XIRLEN            X
    XIRNUM            X
    XIUNIT            X
    XNAME             X
    XNAMED            X
    XNAMELEN          X
    XNEXTREC          X
    XNUMBER           X
    XOPEN             X
    XQACCESS          X
    XQACCLEN          X
    XQBLANK           X
    XQBLANKLEN        X
    XQRECL            X
    XREC              X
    XRECLEN           X
    XSEQ              X
    XSEQLEN           X
    XSTATUS           X
    XUNFMT            X
    XUNFMTLEN         X
    XUNIT             X

##### struct's

    ioclist           X

       1: /* Routines to generate code for I/O statements.
       2:    Some corrections and improvements due to David Wasley, U. C. Berkeley
       3:    Compile with -DKOSHER to force exact conformity with the ANSI std.
       4: */
       5: /*
       6:  * This module supports the ucb fixed libI77. Since it was done
       7:  * on a Vax, some of the naming conventions were different. These were
       8:  * changed to allow compilation on the 11/70 version. wfj 3/26/80
       9:  * <UNTESTED>
      10:  */
      11: /* Modified to handle encode/decode statements.
      12:  * Other files modified to support this feature:
      13:  *	lex.c	    "encode" & "decode" added to key[]
      14:  *	tokens	    SENCODE & SDECODE added
      15:  *	gram.io     modified in an obvious way.
      16:  * John Sender, 7/23/80.
      17:  */
      18:
      19: #ifdef KOSHER
      20: #define IOSRETURN 1  /* to force ANSI std return on iostat= */
      21: #endif
      22:
      23: /* TEMPORARY */
      24: #define TYIOINT TYLONG
      25: #define SZIOINT SZLONG
      26:
      27: #include "defs"
      28: #include "string_defs"
      29:
      30: LOCAL char ioroutine[XL+1];
      31:
      32: LOCAL int ioendlab;
      33: LOCAL int ioerrlab;
      34: LOCAL int iostest;
      35: LOCAL int iosreturn;
      36: LOCAL int jumplab;
      37: LOCAL int skiplab;
      38: LOCAL int ioformatted;
      39: LOCAL expptr ioecdc;    /* encode/decode char cnt */    /* E-D */
      40:
      41: #define UNFORMATTED 0
      42: #define FORMATTED 1
      43: #define LISTDIRECTED 2
      44:
      45: #define V(z)    ioc[z].iocval
      46:
      47: #define IOALL 07777
      48:
      49: LOCAL struct ioclist
      50:     {
      51:     char *iocname;
      52:     int iotype;
      53:     expptr iocval;
      54:     } ioc[ ] =
      55:     {
      56:         { "", 0 },
      57:         { "unit", IOALL },
      58:         { "fmt", M(IOREAD) | M(IOWRITE) },
      59:         { "err", IOALL },
      60: #ifdef KOSHER
      61:         { "end", M(IOREAD) },
      62: #else
      63:         { "end", M(IOREAD) | M(IOWRITE) },
      64: #endif
      65:         { "iostat", IOALL },
      66:         { "rec", M(IOREAD) | M(IOWRITE) },
      67:         { "recl", M(IOOPEN) | M(IOINQUIRE) },
      68:         { "file", M(IOOPEN) | M(IOINQUIRE) },
      69:         { "status", M(IOOPEN) | M(IOCLOSE) },
      70:         { "access", M(IOOPEN) | M(IOINQUIRE) },
      71:         { "form", M(IOOPEN) | M(IOINQUIRE) },
      72:         { "blank", M(IOOPEN) | M(IOINQUIRE) },
      73:         { "exist", M(IOINQUIRE) },
      74:         { "opened", M(IOINQUIRE) },
      75:         { "number", M(IOINQUIRE) },
      76:         { "named", M(IOINQUIRE) },
      77:         { "name", M(IOINQUIRE) },
      78:         { "sequential", M(IOINQUIRE) },
      79:         { "direct", M(IOINQUIRE) },
      80:         { "formatted", M(IOINQUIRE) },
      81:         { "unformatted", M(IOINQUIRE) },
      82:         { "nextrec", M(IOINQUIRE) }
      83:     } ;
      84:
      85: #define NIOS (sizeof(ioc)/sizeof(struct ioclist) - 1)
      86: #define MAXIO   SZFLAG + 10*SZIOINT + 15*SZADDR
      87:
      88: #define IOSUNIT 1
      89: #define IOSFMT 2
      90: #define IOSERR 3
      91: #define IOSEND 4
      92: #define IOSIOSTAT 5
      93: #define IOSREC 6
      94: #define IOSRECL 7
      95: #define IOSFILE 8
      96: #define IOSSTATUS 9
      97: #define IOSACCESS 10
      98: #define IOSFORM 11
      99: #define IOSBLANK 12
     100: #define IOSEXISTS 13
     101: #define IOSOPENED 14
     102: #define IOSNUMBER 15
     103: #define IOSNAMED 16
     104: #define IOSNAME 17
     105: #define IOSSEQUENTIAL 18
     106: #define IOSDIRECT 19
     107: #define IOSFORMATTED 20
     108: #define IOSUNFORMATTED 21
     109: #define IOSNEXTREC 22
     110:
     111: #define IOSTP V(IOSIOSTAT)
     112: #define IOSRW (iostmt==IOREAD || iostmt==IOWRITE)
     113:
     114:
     115: /* offsets in generated structures */
     116:
     117: #define SZFLAG SZIOINT
     118:
     119: /* offsets for external READ and WRITE statements */
     120:
     121: #define XERR 0
     122: #define XUNIT   SZFLAG
     123: #define XEND    SZFLAG + SZIOINT
     124: #define XFMT    2*SZFLAG + SZIOINT
     125: #define XREC    2*SZFLAG + SZIOINT + SZADDR
     126:
     127: /* offsets for internal READ and WRITE statements */
     128:
     129: #define XIERR   0
     130: #define XIUNIT  SZFLAG
     131: #define XIEND   SZFLAG + SZADDR
     132: #define XIFMT   2*SZFLAG + SZADDR
     133: #define XIRLEN  2*SZFLAG + 2*SZADDR
     134: #define XIRNUM  2*SZFLAG + 2*SZADDR + SZIOINT
     135: #define XIREC   2*SZFLAG + 2*SZADDR + 2*SZIOINT
     136:
     137: /* offsets for OPEN statements */
     138:
     139: #define XFNAME  SZFLAG + SZIOINT
     140: #define XFNAMELEN   SZFLAG + SZIOINT + SZADDR
     141: #define XSTATUS SZFLAG + 2*SZIOINT + SZADDR
     142: #define XACCESS SZFLAG + 2*SZIOINT + 2*SZADDR
     143: #define XFORMATTED  SZFLAG + 2*SZIOINT + 3*SZADDR
     144: #define XRECLEN SZFLAG + 2*SZIOINT + 4*SZADDR
     145: #define XBLANK  SZFLAG + 3*SZIOINT + 4*SZADDR
     146:
     147: /* offset for CLOSE statement */
     148:
     149: #define XCLSTATUS   SZFLAG + SZIOINT
     150:
     151: /* offsets for INQUIRE statement */
     152:
     153: #define XFILE   SZFLAG + SZIOINT
     154: #define XFILELEN    SZFLAG + SZIOINT + SZADDR
     155: #define XEXISTS SZFLAG + 2*SZIOINT + SZADDR
     156: #define XOPEN   SZFLAG + 2*SZIOINT + 2*SZADDR
     157: #define XNUMBER SZFLAG + 2*SZIOINT + 3*SZADDR
     158: #define XNAMED  SZFLAG + 2*SZIOINT + 4*SZADDR
     159: #define XNAME   SZFLAG + 2*SZIOINT + 5*SZADDR
     160: #define XNAMELEN    SZFLAG + 2*SZIOINT + 6*SZADDR
     161: #define XQACCESS    SZFLAG + 3*SZIOINT + 6*SZADDR
     162: #define XQACCLEN    SZFLAG + 3*SZIOINT + 7*SZADDR
     163: #define XSEQ    SZFLAG + 4*SZIOINT + 7*SZADDR
     164: #define XSEQLEN SZFLAG + 4*SZIOINT + 8*SZADDR
     165: #define XDIRECT SZFLAG + 5*SZIOINT + 8*SZADDR
     166: #define XDIRLEN SZFLAG + 5*SZIOINT + 9*SZADDR
     167: #define XFORM   SZFLAG + 6*SZIOINT + 9*SZADDR
     168: #define XFORMLEN    SZFLAG + 6*SZIOINT + 10*SZADDR
     169: #define XFMTED  SZFLAG + 7*SZIOINT + 10*SZADDR
     170: #define XFMTEDLEN   SZFLAG + 7*SZIOINT + 11*SZADDR
     171: #define XUNFMT  SZFLAG + 8*SZIOINT + 11*SZADDR
     172: #define XUNFMTLEN   SZFLAG + 8*SZIOINT + 12*SZADDR
     173: #define XQRECL  SZFLAG + 9*SZIOINT + 12*SZADDR
     174: #define XNEXTREC    SZFLAG + 9*SZIOINT + 13*SZADDR
     175: #define XQBLANK SZFLAG + 9*SZIOINT + 14*SZADDR
     176: #define XQBLANKLEN  SZFLAG + 9*SZIOINT + 15*SZADDR
     177:
     178: fmtstmt(lp)
     179: register struct labelblock *lp;
     180: {
     181: if(lp == NULL)
     182:     {
     183:     error("unlabeled format statement" , 0,0,EXECERR);
     184:     return(-1);
     185:     }
     186: if(lp->labtype == LABUNKNOWN)
     187:     {
     188:     lp->labtype = LABFORMAT;
     189:     lp->labelno = newlabel();
     190:     }
     191: else if(lp->labtype != LABFORMAT)
     192:     {
     193:     error("bad format number", 0,0,EXECERR);
     194:     return(-1);
     195:     }
     196: return(lp->labelno);
     197: }
     198:
     199:
     200:
     201: setfmt(lp)
     202: struct labelblock *lp;
     203: {
     204: ftnint n;
     205: char *s, *lexline();
     206:
     207: s = lexline(&n);
     208: preven(ALILONG);
     209: prlabel(asmfile, lp->labelno);
     210: putstr(asmfile, s, n);
     211: flline();
     212: }
     213:
     214:
     215:
     216: startioctl()
     217: {
     218: register int i;
     219:
     220: ioecdc = NULL;                      /* E-D */
     221: inioctl = YES;
     222: nioctl = 0;
     223: ioformatted = UNFORMATTED;
     224: for(i = 1 ; i<=NIOS ; ++i)
     225:     V(i) = NULL;
     226: }
     227:
     228:
     229:
     230: iosetecdc(e)                        /* E-D */
     231: expptr e;                       /* E-D */
     232: {                           /* E-D */
     233:     ioecdc = e;                 /* E-D */
     234: }                           /* E-D */
     235:
     236:
     237:
     238: endioctl()
     239: {
     240: int i;
     241: expptr p;
     242: struct labelblock *mklabel();
     243:
     244: inioctl = NO;
     245: if(ioblkp == NULL)
     246:     ioblkp = autovar( (MAXIO+SZIOINT-1)/SZIOINT , TYIOINT, NULL);
     247:
     248: /* set up for error recovery */
     249:
     250: ioerrlab = ioendlab = jumplab = 0;
     251: skiplab = iosreturn = NO;
     252:
     253: if(p = V(IOSEND))
     254:     if(ISICON(p))
     255:         ioendlab = mklabel(p->const.ci)->labelno;
     256:     else
     257:         error("bad end= clause",0,0,ERR);
     258:
     259: if(p = V(IOSERR))
     260:     if(ISICON(p))
     261:         ioerrlab = mklabel(p->const.ci)->labelno;
     262:     else
     263:         error("bad err= clause",0,0,ERR);
     264:
     265: if(IOSTP)
     266:     if(IOSTP->tag!=TADDR || ! ISINT(IOSTP->vtype) )
     267:         {
     268:         error("iostat must be an integer variable",0,0,ERR);
     269:         frexpr(IOSTP);
     270:         IOSTP = NULL;
     271:         }
     272: #ifdef IOSRETURN
     273:     else
     274:         iosreturn = YES;
     275:
     276: if(iosreturn && IOSRW && !(ioerrlab && ioendlab) )
     277:     {
     278:     jumplab = newlabel();
     279:     iostest = OPEQ;
     280:     if(ioerrlab || ioendlab) skiplab = YES;
     281:     }
     282: else if(ioerrlab && !ioendlab)
     283:
     284: #else
     285: if(ioerrlab && !ioendlab)
     286: #endif
     287:     {
     288:     jumplab = ioerrlab;
     289:     iostest = IOSRW ? OPLE : OPEQ;
     290:     }
     291: else if(!ioerrlab && ioendlab)
     292:     {
     293:     jumplab = ioendlab;
     294:     iostest = OPGE;
     295:     }
     296: else if(ioerrlab && ioendlab)
     297:     {
     298:     iostest = OPEQ;
     299:     if(ioerrlab == ioendlab)
     300:         jumplab = ioerrlab;
     301:     else
     302:         {
     303:         if(!IOSTP) IOSTP = mktemp(TYINT, NULL);
     304:         jumplab = newlabel();
     305:         skiplab = YES;
     306:         }
     307:     }
     308: /*else if(IOSTP)  /* the standard requires this return! */
     309: /*	{
     310: /*	iosreturn = YES;
     311: /*	if(iostmt==IOREAD || iostmt==IOWRITE)
     312: /*		{
     313: /*		jumplab = newlabel();
     314: /*		iostest = OPEQ;
     315: /*		}
     316: /*	}
     317:  */
     318:
     319:
     320: ioset(TYIOINT, XERR, ICON(ioerrlab!=0 || iosreturn) );
     321:
     322: switch(iostmt)
     323:     {
     324:     case IOOPEN:
     325:         dofopen();  break;
     326:
     327:     case IOCLOSE:
     328:         dofclose();  break;
     329:
     330:     case IOINQUIRE:
     331:         dofinquire();  break;
     332:
     333:     case IOBACKSPACE:
     334:         dofmove("f_back"); break;
     335:
     336:     case IOREWIND:
     337:         dofmove("f_rew");  break;
     338:
     339:     case IOENDFILE:
     340:         dofmove("f_end");  break;
     341:
     342:     case IOREAD:
     343:     case IOWRITE:
     344:         startrw();  break;
     345:
     346:     default:
     347:         error("impossible iostmt %d", iostmt,0,FATAL1);
     348:     }
     349: for(i = 1 ; i<=NIOS ; ++i)
     350:     if(i!=IOSIOSTAT && V(i)!=NULL)
     351:         frexpr(V(i));
     352: }
     353:
     354:
     355:
     356: iocname()
     357: {
     358: register int i;
     359: int found, mask;
     360:
     361: found = 0;
     362: mask = M(iostmt);
     363: for(i = 1 ; i <= NIOS ; ++i)
     364:     if(toklen==strlen(ioc[i].iocname) && eqn(toklen, token, ioc[i].iocname))
     365:         if(ioc[i].iotype & mask)
     366:             return(i);
     367:         else    found = i;
     368: if(found)
     369:     error("invalid control %s for statement", ioc[found].iocname,0,ERR1);
     370: else
     371:     error("unknown iocontrol %s", varstr(toklen, token),0,ERR1 );
     372: return(IOSBAD);
     373: }
     374:
     375:
     376: ioclause(n, p)
     377: register int n;
     378: register expptr p;
     379: {
     380: struct ioclist *iocp;
     381:
     382: ++nioctl;
     383: if(n == IOSBAD)
     384:     return;
     385: if(n == IOSPOSITIONAL)
     386:     {
     387:     if(nioctl > IOSFMT)
     388:         {
     389:         error("illegal positional iocontrol",0,0,ERR);
     390:         return;
     391:         }
     392:     n = nioctl;
     393:     }
     394:
     395: if(p == NULL)
     396:     {
     397:     if(n == IOSUNIT)
     398:         p = (iostmt==IOREAD ? IOSTDIN : IOSTDOUT);
     399:     else if(n != IOSFMT)
     400:         {
     401:         error("illegal * iocontrol",0,0,ERR);
     402:         return;
     403:         }
     404:     }
     405: if(n == IOSFMT)
     406:     ioformatted = (p==NULL ? LISTDIRECTED : FORMATTED);
     407:
     408: iocp = & ioc[n];
     409: if(iocp->iocval == NULL)
     410:     {
     411:     if( !ioecdc )                   /* E-D */
     412:         if(n!=IOSFMT && ( n!=IOSUNIT || (p!=NULL && p->vtype!=TYCHAR) ) )
     413:             p = fixtype(p);
     414:     iocp->iocval = p;
     415: }
     416: else
     417:     error("iocontrol %s repeated", iocp->iocname,0,ERR1);
     418: }
     419:
     420: /* io list item */
     421:
     422: doio(list)
     423: chainp list;
     424: {
     425: struct exprblock *call0();
     426: doiolist(list);
     427: ioroutine[0] = 'e';
     428: putiocall( call0(TYINT, ioroutine) );
     429: }
     430:
     431:
     432:
     433:
     434:
     435: LOCAL doiolist(p0)
     436: chainp p0;
     437: {
     438: chainp p;
     439: register tagptr q;
     440: register expptr qe;
     441: register struct nameblock *qn;
     442: struct addrblock *tp, *mkscalar();
     443: int range;
     444:
     445: for (p = p0 ; p ; p = p->nextp)
     446:     {
     447:     q = p->datap;
     448:     if(q->tag == TIMPLDO)
     449:         {
     450:         exdo(range=newlabel(), q->varnp);
     451:         doiolist(q->datalist);
     452:         enddo(range);
     453:         free(q);
     454:         }
     455:     else    {
     456:         if(q->tag==TPRIM && q->argsp==NULL
     457:             && q->namep->vdim!=NULL)
     458:             {
     459:             vardcl(qn = q->namep);
     460:             if(qn->vdim->nelt)
     461:                 putio( fixtype(cpexpr(qn->vdim->nelt)),
     462:                     mkscalar(qn) );
     463:             else
     464:                 error("attempt to i/o array of unknown size",0,0,ERR);
     465:             }
     466:         else if(q->tag==TPRIM && q->argsp==NULL &&
     467:             (qe = memversion(q->namep)) )
     468:             putio(ICON(1),qe);
     469:         else if( (qe = fixtype(cpexpr(q)))->tag==TADDR)
     470:             putio(ICON(1), qe);
     471:         else if(qe->vtype != TYERROR)
     472:             {
     473:             if(iostmt == IOWRITE)
     474:                 {
     475:                 tp = mktemp(qe->vtype, qe->vleng);
     476:                 puteq( cpexpr(tp), qe);
     477:                 putio(ICON(1), tp);
     478:                 }
     479:             else
     480: /*				error("non-left side in READ list",0,0,ERR);
     481: */
     482: /*! changed error message PLWard 10/80 */
     483:                 error("function in READ list",0,0,ERR);
     484:             }
     485:         frexpr(q);
     486:         }
     487:     }
     488: frchain( &p0 );
     489: }
     490:
     491:
     492:
     493:
     494:
     495: LOCAL putio(nelt, addr)
     496: expptr nelt;
     497: register expptr addr;
     498: {
     499: int type;
     500: register struct exprblock *q;
     501: struct exprblock *call2(), *call3();
     502:
     503: type = addr->vtype;
     504: if(ioformatted!=LISTDIRECTED && ISCOMPLEX(type) )
     505:     {
     506:     nelt = mkexpr(OPSTAR, ICON(2), nelt);
     507:     type -= (TYCOMPLEX-TYREAL);
     508:     }
     509:
     510: /* pass a length with every item.  for noncharacter data, fake one */
     511: if(type != TYCHAR)
     512:     {
     513:     if( ISCONST(addr) )
     514:         addr = putconst(addr);
     515:     addr->vtype = TYCHAR;
     516:     addr->vleng = ICON( typesize[type] );
     517:     }
     518:
     519: nelt = fixtype( mkconv(TYLENG,nelt) );
     520: if(ioformatted == LISTDIRECTED)
     521:     q = call3(TYINT, "do_lio", mkconv(TYLONG, ICON(type)), nelt, addr);
     522: else
     523:     q = call2(TYINT, (ioformatted==FORMATTED ? "do_fio" : "do_uio"),
     524:         nelt, addr);
     525: putiocall(q);
     526: }
     527:
     528:
     529:
     530:
     531: endio()
     532: {
     533: if(skiplab)
     534:     {
     535:     putlabel(jumplab);
     536:     if(ioendlab) putif( mkexpr(OPGE, cpexpr(IOSTP), ICON(0)), ioendlab);
     537:     if(ioerrlab) putif( mkexpr(OPLE, cpexpr(IOSTP), ICON(0)), ioerrlab);
     538:     }
     539: else if(iosreturn && jumplab)
     540:     putlabel(jumplab);
     541: if(IOSTP)
     542:     frexpr(IOSTP);
     543: }
     544:
     545:
     546:
     547: LOCAL putiocall(q)
     548: register struct exprblock *q;
     549: {
     550: if(IOSTP)
     551:     {
     552:     q->vtype = TYINT;
     553:     q = fixexpr( mkexpr(OPASSIGN, cpexpr(IOSTP), q));
     554:     }
     555:
     556: if(jumplab)
     557:     putif( mkexpr(iostest, q, ICON(0) ), jumplab);
     558: else
     559:     putexpr(q);
     560: }
     561:
     562:
     563: startrw()
     564: {
     565: register expptr p;
     566: register struct nameblock *np;
     567: register struct addrblock *unitp, *nump;
     568: struct constblock *mkaddcon();
     569: int k, fmtoff;
     570: int intfile, sequential;
     571:
     572: intfile = NO;
     573: if(p = V(IOSUNIT))
     574:     {
     575:     if( ISINT(p->vtype) )
     576:         ioset(TYIOINT, XUNIT, cpexpr(p) );
     577:     else if( ioecdc || p->vtype == TYCHAR)      /* E-D */
     578:         {
     579:         intfile = YES;
     580:         if(p->tag==TPRIM && p->argsp==NULL &&
     581:             (np = p->namep)->vdim!=NULL)
     582:             {
     583:             vardcl(np);
     584:             if( ioecdc )            /* E-D */
     585:                 nump = ICON(1);     /* E-D */
     586:             else if(np->vdim->nelt)     /* E-D */
     587:                 nump = cpexpr(np->vdim->nelt);
     588:             else
     589:                 {
     590:                 error("attempt to use internal unit array of unknown size",0,0,ERR);
     591:                 nump = ICON(1);
     592:                 }
     593:             unitp = mkscalar(np);
     594:             }
     595:         else    {
     596:             nump = ICON(1);
     597:             unitp = fixtype(cpexpr(p));
     598:             }
     599:         if( ioecdc )                /* E-D */
     600:             {               /* E-D */
     601:             frexpr( unitp->vleng );     /* E-D */
     602:             unitp->vleng = ioecdc;      /* E-D */
     603:             }               /* E-D */
     604:         ioset(TYIOINT, XIRNUM, nump);
     605:         ioset(TYIOINT, XIRLEN, cpexpr(unitp->vleng) );
     606:         ioset(TYADDR, XIUNIT, addrof(unitp) );
     607:         }
     608:     }
     609: else
     610:     error("bad unit specifier",0,0,ERR);
     611:
     612: sequential = YES;
     613: if(p = V(IOSREC))
     614:     if( ISINT(p->vtype) )
     615:         {
     616:         ioset(TYIOINT, (intfile ? XIREC : XREC), cpexpr(p) );
     617:         sequential = NO;
     618:         }
     619:     else
     620:         error("bad REC= clause",0,0,ERR);
     621:
     622: ioset(TYIOINT, (intfile ? XIEND : XEND), ICON(ioendlab!=0 || iosreturn) );
     623:
     624: fmtoff = (intfile ? XIFMT : XFMT);
     625:
     626: if(p = V(IOSFMT))
     627:     {
     628:     if(p->tag==TPRIM && p->argsp==NULL)
     629:         {
     630:         vardcl(np = p->namep);
     631:         if(np->vdim)
     632:             {
     633:             ioset(TYADDR, fmtoff, addrof(mkscalar(np)) );
     634:             goto endfmt;
     635:             }
     636:         if( ISINT(np->vtype) )
     637:             {
     638:             ioset(TYADDR, fmtoff, p);
     639:             goto endfmt;
     640:             }
     641:         }
     642:     p = V(IOSFMT) = fixtype(p);
     643:     if(p->vtype == TYCHAR)
     644:         ioset(TYADDR, fmtoff, addrof(cpexpr(p)) );
     645:     else if( ISICON(p) )
     646:         {
     647:         if( (k = fmtstmt( mklabel(p->const.ci) )) > 0 )
     648:             ioset(TYADDR, fmtoff, mkaddcon(k) );
     649:         else
     650:             ioformatted = UNFORMATTED;
     651:         }
     652:     else    {
     653:         error("bad format descriptor",0,0,ERR);
     654:         ioformatted = UNFORMATTED;
     655:         }
     656:     }
     657: else
     658:     ioset(TYADDR, fmtoff, ICON(0) );
     659:
     660: endfmt:
     661:     if(intfile && ioformatted==UNFORMATTED)
     662:         error("unformatted internal I/O not allowed",0,0,ERR);
     663:     if(!sequential && ioformatted==LISTDIRECTED)
     664:         error("direct list-directed I/O not allowed",0,0,ERR);
     665:
     666: ioroutine[0] = 's';
     667: ioroutine[1] = '_';
     668: ioroutine[2] = (iostmt==IOREAD ? 'r' : 'w');
     669: ioroutine[3] = (sequential ? 's' : 'd');
     670: ioroutine[4] = "ufl" [ioformatted];
     671: ioroutine[5] = (intfile ? 'i' : 'e');
     672: ioroutine[6] = '\0';
     673: putiocall( call1(TYINT, ioroutine, cpexpr(ioblkp) ));
     674: }
     675:
     676:
     677:
     678: LOCAL dofopen()
     679: {
     680: register expptr p;
     681:
     682: if( (p = V(IOSUNIT)) && ISINT(p->vtype) )
     683:     ioset(TYIOINT, XUNIT, cpexpr(p) );
     684: else
     685:     error("bad unit in open",0,0,ERR);
     686: if( (p = V(IOSFILE)) )
     687:     if(p->vtype == TYCHAR)
     688:         ioset(TYIOINT, XFNAMELEN, cpexpr(p->vleng) );
     689:     else
     690:         error("bad file in open",0,0,ERR);
     691:
     692: iosetc(XFNAME, p);
     693:
     694: if(p = V(IOSRECL))
     695:     if( ISINT(p->vtype) )
     696:         ioset(TYIOINT, XRECLEN, cpexpr(p) );
     697:     else
     698:         error("bad recl",0,0,ERR);
     699: else
     700:     ioset(TYIOINT, XRECLEN, ICON(0) );
     701:
     702: iosetc(XSTATUS, V(IOSSTATUS));
     703: iosetc(XACCESS, V(IOSACCESS));
     704: iosetc(XFORMATTED, V(IOSFORM));
     705: iosetc(XBLANK, V(IOSBLANK));
     706:
     707: putiocall( call1(TYINT, "f_open", cpexpr(ioblkp) ));
     708: }
     709:
     710:
     711: LOCAL dofclose()
     712: {
     713: register expptr p;
     714:
     715: if( (p = V(IOSUNIT)) && ISINT(p->vtype) )
     716:     {
     717:     ioset(TYIOINT, XUNIT, cpexpr(p) );
     718:     iosetc(XCLSTATUS, V(IOSSTATUS));
     719:     putiocall( call1(TYINT, "f_clos", cpexpr(ioblkp)) );
     720:     }
     721: else
     722:     error("bad unit in close statement",0,0,ERR);
     723: }
     724:
     725:
     726: LOCAL dofinquire()
     727: {
     728: register expptr p;
     729: if(p = V(IOSUNIT))
     730:     {
     731:     if( V(IOSFILE) )
     732:         error("inquire by unit or by file, not both",0,0,ERR);
     733:     ioset(TYIOINT, XUNIT, cpexpr(p) );
     734:     }
     735: else if( ! V(IOSFILE) )
     736:     error("must inquire by unit or by file",0,0,ERR);
     737: iosetlc(IOSFILE, XFILE, XFILELEN);
     738: iosetip(IOSEXISTS, XEXISTS);
     739: iosetip(IOSOPENED, XOPEN);
     740: iosetip(IOSNUMBER, XNUMBER);
     741: iosetip(IOSNAMED, XNAMED);
     742: iosetlc(IOSNAME, XNAME, XNAMELEN);
     743: iosetlc(IOSACCESS, XQACCESS, XQACCLEN);
     744: iosetlc(IOSSEQUENTIAL, XSEQ, XSEQLEN);
     745: iosetlc(IOSDIRECT, XDIRECT, XDIRLEN);
     746: iosetlc(IOSFORM, XFORM, XFORMLEN);
     747: iosetlc(IOSFORMATTED, XFMTED, XFMTEDLEN);
     748: iosetlc(IOSUNFORMATTED, XUNFMT, XUNFMTLEN);
     749: iosetip(IOSRECL, XQRECL);
     750: iosetip(IOSNEXTREC, XNEXTREC);
     751: iosetlc(IOSBLANK, XQBLANK, XQBLANKLEN);
     752:
     753: putiocall( call1(TYINT,  "f_inqu", cpexpr(ioblkp) ));
     754: }
     755:
     756:
     757:
     758: LOCAL dofmove(subname)
     759: char *subname;
     760: {
     761: register expptr p;
     762:
     763: if( (p = V(IOSUNIT)) && ISINT(p->vtype) )
     764:     {
     765:     ioset(TYIOINT, XUNIT, cpexpr(p) );
     766:     putiocall( call1(TYINT, subname, cpexpr(ioblkp) ));
     767:     }
     768: else
     769:     error("bad unit in I/O motion statement",0,0,ERR);
     770: }
     771:
     772:
     773:
     774: LOCAL ioset(type, offset, p)
     775: int type, offset;
     776: expptr p;
     777: {
     778: register struct addrblock *q;
     779:
     780: q = cpexpr(ioblkp);
     781: q->vtype = type;
     782: q->memoffset = fixtype( mkexpr(OPPLUS, q->memoffset, ICON(offset)) );
     783: puteq(q, p);
     784: }
     785:
     786:
     787:
     788:
     789: LOCAL iosetc(offset, p)
     790: int offset;
     791: register expptr p;
     792: {
     793: if(p == NULL)
     794:     ioset(TYADDR, offset, ICON(0) );
     795: else if(p->vtype == TYCHAR)
     796:     ioset(TYADDR, offset, addrof(cpexpr(p) ));
     797: else
     798:     error("non-character control clause",0,0,ERR);
     799: }
     800:
     801:
     802:
     803: LOCAL iosetip(i, offset)
     804: int i, offset;
     805: {
     806: register expptr p;
     807:
     808: if(p = V(i))
     809:     if(p->tag==TADDR &&
     810:         ONEOF(p->vtype, M(TYLONG)|M(TYLOGICAL)) )
     811:         ioset(TYADDR, offset, addrof(cpexpr(p)) );
     812:     else
     813:         error("impossible inquire parameter %s", ioc[i].iocname,0,ERR1);
     814: else
     815:     ioset(TYADDR, offset, ICON(0) );
     816: }
     817:
     818:
     819:
     820: LOCAL iosetlc(i, offp, offl)
     821: int i, offp, offl;
     822: {
     823: register expptr p;
     824: if( (p = V(i)) && p->vtype==TYCHAR)
     825:     ioset(TYIOINT, offl, cpexpr(p->vleng) );
     826: iosetc(offp, p);
     827: }

#### Defined functions

dofclose defined in line 711; used 1 times

- in line 328

dofinquire defined in line 726; used 1 times

- in line 331

dofmove defined in line 758; used 3 times

- in line 334-340(3)

dofopen defined in line 678; used 1 times

- in line 325

doio defined in line 422; used 11 times

- in /usr/src/usr.bin/f77/gram.io line 12-32(11)

doiolist defined in line 435; used 2 times

- in line 426, 451

endio defined in line 531; used 1 times

- in /usr/src/usr.bin/f77/gram.io line 4

endioctl defined in line 238; used 8 times

- in /usr/src/usr.bin/f77/gram.io line 9, 61, 67-74(3), 100, 125, 132

fmtstmt defined in line 178; used 2 times

- in line 647
- in /usr/src/usr.bin/f77/gram.dcl line 12

ioclause defined in line 376; used 19 times

- in /usr/src/usr.bin/f77/gram.io line 9, 59-66(4), 72-88(8), 98-99(2), 123-124(2), 130-131(2)

iocname defined in line 356; used 7 times

- in line 51, 364-369(3), 417, 813
- in /usr/src/usr.bin/f77/gram.io line 92

ioset defined in line 774; used 24 times

- in line 320, 576, 604-606(3), 616, 622, 633-638(2), 644-648(2), 658, 683-688(2), 696-700(2), 717, 733, 765, 794-796(2), 811-815(2), 825

iosetc defined in line 789; used 7 times

- in line 692, 702-705(4), 718, 826

iosetecdc defined in line 230; used 1 times

- in /usr/src/usr.bin/f77/gram.io line 97

iosetip defined in line 803; used 6 times

- in line 738-741(4), 749-750(2)

iosetlc defined in line 820; used 9 times

- in line 737-751(9)

putio defined in line 495; used 4 times

- in line 461, 468-470(2), 477

putiocall defined in line 547; used 7 times

- in line 428, 525, 673, 707, 719, 753, 766

setfmt defined in line 201; used 1 times

- in /usr/src/usr.bin/f77/gram.dcl line 12

startioctl defined in line 216; used 1 times

- in /usr/src/usr.bin/f77/gram.io line 178

startrw defined in line 563; used 1 times

- in line 344

#### Defined variables

ioc defined in line 54; used 8 times

- in line 45, 85, 364-369(4), 408, 813

ioecdc defined in line 39; used 7 times

- in line 220, 233, 411, 577, 584, 599-602(2)

ioendlab defined in line 32; used 13 times

- in line 250-255(2), 276-285(4), 291-299(4), 536(2), 622

ioerrlab defined in line 33; used 14 times

- in line 250, 261, 276-300(9), 320, 537(2)

ioformatted defined in line 38; used 10 times

- in line 223, 406, 504, 520-523(2), 650-654(2), 661-663(2), 670

ioroutine defined in line 30; used 10 times

- in line 427-428(2), 666-673(8)

iosreturn defined in line 35; used 6 times

- in line 251, 274-276(2), 320, 539, 622

iostest defined in line 34; used 5 times

- in line 279, 289-298(3), 557

jumplab defined in line 36; used 11 times

- in line 250, 278, 288-293(2), 300-304(2), 535-540(3), 556-557(2)

skiplab defined in line 37; used 4 times

- in line 251, 280, 305, 533

#### Defined struct's

ioclist defined in line 49; used 2 times

- in line 380(2)

#### Defined macros

FORMATTED defined in line 42; used 2 times

- in line 406, 523

IOALL defined in line 47; used 3 times

- in line 57-59(2), 65

IOSACCESS defined in line 97; used 2 times

- in line 703, 743

IOSBLANK defined in line 99; used 2 times

- in line 705, 751

IOSDIRECT defined in line 106; used 1 times

- in line 745

IOSEND defined in line 91; used 1 times

- in line 253

IOSERR defined in line 90; used 1 times

- in line 259

IOSEXISTS defined in line 100; used 1 times

- in line 738

IOSFILE defined in line 95; used 4 times

- in line 686, 731-737(3)

IOSFMT defined in line 89; used 6 times

- in line 387, 399, 405, 412, 626, 642

IOSFORM defined in line 98; used 2 times

- in line 704, 746

IOSFORMATTED defined in line 107; used 1 times

- in line 747

IOSIOSTAT defined in line 92; used 2 times

- in line 111, 350

IOSNAME defined in line 104; used 1 times

- in line 742

IOSNAMED defined in line 103; used 1 times

- in line 741

IOSNEXTREC defined in line 109; used 1 times

- in line 750

IOSNUMBER defined in line 102; used 1 times

- in line 740

IOSOPENED defined in line 101; used 1 times

- in line 739

IOSREC defined in line 93; used 1 times

- in line 613

IOSRECL defined in line 94; used 2 times

- in line 694, 749

IOSRETURN defined in line 20; used 1 times

- in line 272

IOSRW defined in line 112; used 2 times

- in line 276, 289

IOSSEQUENTIAL defined in line 105; used 1 times

- in line 744

IOSSTATUS defined in line 96; used 2 times

- in line 702, 718

IOSTP defined in line 111; used 13 times

- in line 265-270(5), 303(2), 536-542(4), 550-553(2)

IOSUNFORMATTED defined in line 108; used 1 times

- in line 748

IOSUNIT defined in line 88; used 7 times

- in line 397, 412, 573, 682, 715, 729, 763

LISTDIRECTED defined in line 43; used 4 times

- in line 406, 504, 520, 663

MAXIO defined in line 86; used 1 times

- in line 246

NIOS defined in line 85; used 3 times

- in line 224, 349, 363

SZFLAG defined in line 117; used 43 times

- in line 86, 122-176(42)

SZIOINT defined in line 25; used 41 times

- in line 86, 117, 123-125(3), 134-176(34), 246(2)

TYIOINT defined in line 24; used 15 times

- in line 246, 320, 576, 604-605(2), 616, 622, 683-688(2), 696-700(2), 717, 733, 765, 825

UNFORMATTED defined in line 41; used 4 times

- in line 223, 650-654(2), 661

V defined in line 45; used 25 times

- in line 111, 225, 253, 259, 350-351(2), 573, 613, 626, 642, 682-686(2), 694, 702-705(4), 715-718(2), 729-735(3), 763, 808, 824

XACCESS defined in line 142; used 1 times

- in line 703

XBLANK defined in line 145; used 1 times

- in line 705

XCLSTATUS defined in line 149; used 1 times

- in line 718

XDIRECT defined in line 165; used 1 times

- in line 745

XDIRLEN defined in line 166; used 1 times

- in line 745

XEND defined in line 123; used 1 times

- in line 622

XERR defined in line 121; used 1 times

- in line 320

XEXISTS defined in line 155; used 1 times

- in line 738

XFILE defined in line 153; used 1 times

- in line 737

XFILELEN defined in line 154; used 1 times

- in line 737

XFMT defined in line 124; used 1 times

- in line 624

XFMTED defined in line 169; used 1 times

- in line 747

XFMTEDLEN defined in line 170; used 1 times

- in line 747

XFNAME defined in line 139; used 1 times

- in line 692

XFNAMELEN defined in line 140; used 1 times

- in line 688

XFORM defined in line 167; used 1 times

- in line 746

XFORMATTED defined in line 143; used 1 times

- in line 704

XFORMLEN defined in line 168; used 1 times

- in line 746

XIEND defined in line 131; used 1 times

- in line 622

XIERR defined in line 129; never used
XIFMT defined in line 132; used 1 times

- in line 624

XIREC defined in line 135; used 1 times

- in line 616

XIRLEN defined in line 133; used 1 times

- in line 605

XIRNUM defined in line 134; used 1 times

- in line 604

XIUNIT defined in line 130; used 1 times

- in line 606

XNAME defined in line 159; used 1 times

- in line 742

XNAMED defined in line 158; used 1 times

- in line 741

XNAMELEN defined in line 160; used 1 times

- in line 742

XNEXTREC defined in line 174; used 1 times

- in line 750

XNUMBER defined in line 157; used 1 times

- in line 740

XOPEN defined in line 156; used 1 times

- in line 739

XQACCESS defined in line 161; used 1 times

- in line 743

XQACCLEN defined in line 162; used 1 times

- in line 743

XQBLANK defined in line 175; used 1 times

- in line 751

XQBLANKLEN defined in line 176; used 1 times

- in line 751

XQRECL defined in line 173; used 1 times

- in line 749

XREC defined in line 125; used 1 times

- in line 616

XRECLEN defined in line 144; used 2 times

- in line 696-700(2)

XSEQ defined in line 163; used 1 times

- in line 744

XSEQLEN defined in line 164; used 1 times

- in line 744

XSTATUS defined in line 141; used 1 times

- in line 702

XUNFMT defined in line 171; used 1 times

- in line 748

XUNFMTLEN defined in line 172; used 1 times

- in line 748

XUNIT defined in line 122; used 5 times

- in line 576, 683, 717, 733, 765

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