2.9BSD - /usr/src/lib/libI77/old_io.c

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

Defined functions

Defined variables

Defined struct's

Defined macros