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