home *** CD-ROM | disk | FTP | other *** search
/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Trees / V7 / usr / src / cmd / f77 / io.c < prev    next >
Encoding:
C/C++ Source or Header  |  1979-01-10  |  13.7 KB  |  735 lines
  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. }
  735.