1 /* Id: io.c,v 1.15 2008/12/19 08:08:48 ragge Exp */
2 /* $NetBSD: io.c,v 1.1.1.3 2010/06/03 18:57:49 plunky Exp $ */
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
45 LOCAL void doiolist(chainp);
46 LOCAL void dofopen(void);
47 LOCAL void dofclose(void);
48 LOCAL void dofinquire(void);
49 LOCAL void dofmove(char *);
50 LOCAL void ioset(int, int, bigptr);
51 LOCAL void iosetc(int, bigptr);
52 LOCAL void iosetip(int, int);
53 LOCAL void iosetlc(int, int, int);
54 LOCAL void putiocall(struct bigblock *q);
55 LOCAL void putio(bigptr, bigptr);
56 LOCAL void startrw(void);
57
58
59 LOCAL char ioroutine[XL+1];
60
61 LOCAL int ioendlab;
62 LOCAL int ioerrlab;
63 LOCAL int endbit;
64 LOCAL int jumplab;
65 LOCAL int skiplab;
66 LOCAL 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
76 LOCAL 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
188 int
fmtstmt(lp)189 fmtstmt(lp)
190 register struct labelblock *lp;
191 {
192 if(lp == NULL)
193 {
194 execerr("unlabeled format statement" , 0);
195 return(-1);
196 }
197 if(lp->labtype == LABUNKNOWN)
198 {
199 lp->labtype = LABFORMAT;
200 lp->labelno = newlabel();
201 }
202 else if(lp->labtype != LABFORMAT)
203 {
204 execerr("bad format number", 0);
205 return(-1);
206 }
207 return(lp->labelno);
208 }
209
210
211 void
setfmt(struct labelblock * lp)212 setfmt(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
225 void
startioctl()226 startioctl()
227 {
228 unsigned int i;
229
230 inioctl = YES;
231 nioctl = 0;
232 ioerrlab = 0;
233 ioformatted = UNFORMATTED;
234 for(i = 1 ; i<=NIOS ; ++i)
235 V(i) = NULL;
236 }
237
238
239 void
endioctl()240 endioctl()
241 {
242 unsigned int i;
243 bigptr p;
244
245 inioctl = NO;
246 if(ioblkp == NULL)
247 ioblkp = autovar( (MAXIO+FSZIOINT-1)/FSZIOINT , TYIOINT, NULL);
248
249 /* set up for error recovery */
250
251 ioerrlab = ioendlab = skiplab = jumplab = 0;
252
253 if((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
260 if((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
267 if(IOSTP==NULL && ioerrlab!=0 && ioendlab!=0 && ioerrlab!=ioendlab)
268 IOSTP = fmktemp(TYINT, NULL);
269
270 if(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
279 if(IOSTP)
280 {
281 if( (iostmt==IOREAD || iostmt==IOWRITE) &&
282 (ioerrlab!=ioendlab || ioerrlab==0) )
283 jumplab = skiplab = newlabel();
284 else
285 jumplab = ioerrlab;
286 }
287 else
288 {
289 jumplab = ioerrlab;
290 if(ioendlab)
291 jumplab = ioendlab;
292 }
293
294 ioset(TYIOINT, XERR, MKICON(IOSTP!=NULL || ioerrlab!=0) );
295 endbit = IOSTP!=NULL || ioendlab!=0; /* for use in startrw() */
296
297 switch(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 }
324 for(i = 1 ; i<=NIOS ; ++i)
325 if(i!=IOSIOSTAT || (iostmt!=IOREAD && iostmt!=IOWRITE) )
326 frexpr(V(i));
327 }
328
329
330 int
iocname()331 iocname()
332 {
333 unsigned int i;
334 int found, mask;
335
336 found = 0;
337 mask = M(iostmt);
338 for(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
346 if(found)
347 err1("invalid control %s for statement", ioc[found].iocname);
348 else
349 err1("unknown iocontrol %s", varstr(toklen, token) );
350 return(IOSBAD);
351 }
352
353 void
ioclause(n,p)354 ioclause(n, p)
355 register int n;
356 register bigptr 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 p = cpexpr(p);
390 if(n!=IOSFMT && ( n!=IOSUNIT || (p!=NULL && p->vtype!=TYCHAR) ) )
391 p = fixtype(p);
392 iocp->iocval = p;
393 }
394 else
395 err1("iocontrol %s repeated", iocp->iocname);
396 }
397
398 /* io list item */
399 void
doio(list)400 doio(list)
401 chainp list;
402 {
403 doiolist(list);
404 ioroutine[0] = 'e';
405 putiocall( call0(TYINT, ioroutine) );
406 frexpr(IOSTP);
407 }
408
409
410
411
412
doiolist(p0)413 LOCAL void doiolist(p0)
414 chainp p0;
415 {
416 chainp p;
417 register bigptr q;
418 register bigptr qe;
419 register struct bigblock *qn;
420 struct bigblock *tp;
421 int range;
422
423 for (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 }
461 frchain( &p0 );
462 }
463
464
465
466
467
468 LOCAL void
putio(nelt,addr)469 putio(nelt, addr)
470 bigptr nelt;
471 register bigptr addr;
472 {
473 int type;
474 register struct bigblock *q;
475
476 type = addr->vtype;
477 if(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 */
484 if(type != TYCHAR)
485 {
486 if( ISCONST(addr) )
487 addr = putconst(addr);
488 addr->vtype = TYCHAR;
489 addr->vleng = MKICON( typesize[type] );
490 }
491
492 nelt = fixtype( mkconv(TYLENG,nelt) );
493 if(ioformatted == LISTDIRECTED)
494 q = call3(TYINT, "do_lio", mkconv(TYLONG, MKICON(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 void
endio()504 endio()
505 {
506 if(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 }
515 if(IOSTP)
516 frexpr(IOSTP);
517 }
518
519
520
521 LOCAL void
putiocall(q)522 putiocall(q)
523 register struct bigblock *q;
524 {
525 if(IOSTP)
526 {
527 q->vtype = TYINT;
528 q = fixexpr( mkexpr(OPASSIGN, cpexpr(IOSTP), q));
529 }
530
531 if(jumplab)
532 putif( mkexpr(OPEQ, q, MKICON(0) ), jumplab);
533 else
534 putexpr(q);
535 }
536
537
538 void
startrw()539 startrw()
540 {
541 register bigptr p;
542 register struct bigblock *np;
543 register struct bigblock *unitp, *nump;
544 int k, fmtoff;
545 int intfile, sequential;
546
547
548 sequential = YES;
549 if((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
559 intfile = NO;
560 if((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 }
588 else
589 err("bad unit specifier");
590
591 if(iostmt == IOREAD)
592 ioset(TYIOINT, (intfile ? XIEND : XEND), MKICON(endbit) );
593
594 fmtoff = (intfile ? XIFMT : XFMT);
595
596 if((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 }
627 else
628 ioset(TYADDR, fmtoff, MKICON(0) );
629
630 endfmt:
631
632
633 ioroutine[0] = 's';
634 ioroutine[1] = '_';
635 ioroutine[2] = (iostmt==IOREAD ? 'r' : 'w');
636 ioroutine[3] = (sequential ? 's' : 'd');
637 ioroutine[4] = "ufl" [ioformatted];
638 ioroutine[5] = (intfile ? 'i' : 'e');
639 ioroutine[6] = '\0';
640 putiocall( call1(TYINT, ioroutine, cpexpr(ioblkp) ));
641 }
642
643
644
dofopen()645 LOCAL void dofopen()
646 {
647 register bigptr p;
648
649 if( (p = V(IOSUNIT)) && ISINT(p->vtype) )
650 ioset(TYIOINT, XUNIT, cpexpr(p) );
651 else
652 err("bad unit in open");
653 if( (p = V(IOSFILE)) && p->vtype==TYCHAR)
654 {
655 ioset(TYIOINT, XFNAMELEN, cpexpr(p->vleng) );
656 iosetc(XFNAME, p);
657 }
658 else
659 err("bad file in open");
660
661 if((p = V(IOSRECL)))
662 if( ISINT(p->vtype) )
663 ioset(TYIOINT, XRECLEN, cpexpr(p) );
664 else
665 err("bad recl");
666 else
667 ioset(TYIOINT, XRECLEN, MKICON(0) );
668
669 iosetc(XSTATUS, V(IOSSTATUS));
670 iosetc(XACCESS, V(IOSACCESS));
671 iosetc(XFORMATTED, V(IOSFORM));
672 iosetc(XBLANK, V(IOSBLANK));
673
674 putiocall( call1(TYINT, "f_open", cpexpr(ioblkp) ));
675 }
676
677
678 LOCAL void
dofclose()679 dofclose()
680 {
681 register bigptr p;
682
683 if( (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 }
689 else
690 err("bad unit in close statement");
691 }
692
693
dofinquire()694 LOCAL void dofinquire()
695 {
696 register bigptr p;
697 if((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 }
703 else if( ! V(IOSFILE) )
704 err("must inquire by unit or by file");
705 iosetlc(IOSFILE, XFILE, XFILELEN);
706 iosetip(IOSEXISTS, XEXISTS);
707 iosetip(IOSOPENED, XOPEN);
708 iosetip(IOSNUMBER, XNUMBER);
709 iosetip(IOSNAMED, XNAMED);
710 iosetlc(IOSNAME, XNAME, XNAMELEN);
711 iosetlc(IOSACCESS, XQACCESS, XQACCLEN);
712 iosetlc(IOSSEQUENTIAL, XSEQ, XSEQLEN);
713 iosetlc(IOSDIRECT, XDIRECT, XDIRLEN);
714 iosetlc(IOSFORM, XFORM, XFORMLEN);
715 iosetlc(IOSFORMATTED, XFMTED, XFMTEDLEN);
716 iosetlc(IOSUNFORMATTED, XUNFMT, XUNFMTLEN);
717 iosetip(IOSRECL, XQRECL);
718 iosetip(IOSNEXTREC, XNEXTREC);
719
720 putiocall( call1(TYINT, "f_inqu", cpexpr(ioblkp) ));
721 }
722
723
724
725 LOCAL void
dofmove(subname)726 dofmove(subname)
727 char *subname;
728 {
729 register bigptr p;
730
731 if( (p = V(IOSUNIT)) && ISINT(p->vtype) )
732 {
733 ioset(TYIOINT, XUNIT, cpexpr(p) );
734 putiocall( call1(TYINT, subname, cpexpr(ioblkp) ));
735 }
736 else
737 err("bad unit in move statement");
738 }
739
740
741
742 LOCAL void
ioset(type,offset,p)743 ioset(type, offset, p)
744 int type, offset;
745 bigptr p;
746 {
747 register struct bigblock *q;
748
749 q = cpexpr(ioblkp);
750 q->vtype = type;
751 q->b_addr.memoffset = fixtype( mkexpr(OPPLUS, q->b_addr.memoffset, MKICON(offset)) );
752 puteq(q, p);
753 }
754
755
756
757
758 LOCAL void
iosetc(offset,p)759 iosetc(offset, p)
760 int offset;
761 register bigptr p;
762 {
763 if(p == NULL)
764 ioset(TYADDR, offset, MKICON(0) );
765 else if(p->vtype == TYCHAR)
766 ioset(TYADDR, offset, addrof(cpexpr(p) ));
767 else
768 err("non-character control clause");
769 }
770
771
772
773 LOCAL void
iosetip(i,offset)774 iosetip(i, offset)
775 int i, offset;
776 {
777 register bigptr p;
778
779 if((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
790 LOCAL void
iosetlc(i,offp,offl)791 iosetlc(i, offp, offl)
792 int i, offp, offl;
793 {
794 register bigptr p;
795 if( (p = V(i)) && p->vtype==TYCHAR)
796 ioset(TYIOINT, offl, cpexpr(p->vleng) );
797 iosetc(offp, p);
798 }
799