UNIX 7th Ed. - /usr/src/cmd/f77/io.c

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

Defined functions

Defined variables

Defined struct's

Defined macros