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