xref: /csrg-svn/usr.bin/f77/pass1.vax/io.c (revision 47955)
1*47955Sbostic /*-
2*47955Sbostic  * Copyright (c) 1980 The Regents of the University of California.
3*47955Sbostic  * All rights reserved.
4*47955Sbostic  *
5*47955Sbostic  * %sccs.include.proprietary.c%
622836Smckusick  */
722836Smckusick 
822836Smckusick #ifndef lint
9*47955Sbostic static char sccsid[] = "@(#)io.c	5.5 (Berkeley) 04/12/91";
10*47955Sbostic #endif /* not lint */
1122836Smckusick 
1222836Smckusick /*
1322836Smckusick  * io.c
1422836Smckusick  *
1522836Smckusick  * Routines to generate code for I/O statements.
1622836Smckusick  * Some corrections and improvements due to David Wasley, U. C. Berkeley
1722836Smckusick  *
1822836Smckusick  * University of Utah CS Dept modification history:
1922836Smckusick  *
2026511Sdonn  * $Header: io.c,v 5.3 86/03/04 17:45:33 donn Exp $
2122836Smckusick  * $Log:	io.c,v $
2226511Sdonn  * Revision 5.3  86/03/04  17:45:33  donn
2326511Sdonn  * Change the order of length and offset code in startrw() -- always emit
2426511Sdonn  * the memoffset first, since it may define a temporary which is used in
2526511Sdonn  * the length expression.
2626511Sdonn  *
2725741Sdonn  * Revision 5.2  85/12/19  17:22:35  donn
2825741Sdonn  * Don't permit more than one 'positional iocontrol' parameter unless we
2925741Sdonn  * are doing a READ or a WRITE.
3025741Sdonn  *
3125741Sdonn  * Revision 5.1  85/08/10  03:47:42  donn
3225741Sdonn  * 4.3 alpha
3325741Sdonn  *
3422836Smckusick  * Revision 2.4  85/02/23  21:09:02  donn
3522836Smckusick  * Jerry Berkman's compiled format fixes move setfmt into a separate file.
3622836Smckusick  *
3722836Smckusick  * Revision 2.3  85/01/10  22:33:41  donn
3822836Smckusick  * Added some strategic cpexpr()s to prevent memory management bugs.
3922836Smckusick  *
4022836Smckusick  * Revision 2.2  84/08/04  21:15:47  donn
4122836Smckusick  * Removed code that creates extra statement labels, per Jerry Berkman's
4222836Smckusick  * fixes to make ASSIGNs work right.
4322836Smckusick  *
4422836Smckusick  * Revision 2.1  84/07/19  12:03:33  donn
4522836Smckusick  * Changed comment headers for UofU.
4622836Smckusick  *
4722836Smckusick  * Revision 1.2  84/02/26  06:35:57  donn
4822836Smckusick  * Added Berkeley changes necessary for shortening offsets to data.
4922836Smckusick  *
5022836Smckusick  */
5122836Smckusick 
5222836Smckusick /* TEMPORARY */
5322836Smckusick #define TYIOINT TYLONG
5422836Smckusick #define SZIOINT SZLONG
5522836Smckusick 
5622836Smckusick #include "defs.h"
5722836Smckusick #include "io.h"
5822836Smckusick 
5922836Smckusick 
6022836Smckusick LOCAL char ioroutine[XL+1];
6122836Smckusick 
6222836Smckusick LOCAL int ioendlab;
6322836Smckusick LOCAL int ioerrlab;
6422836Smckusick LOCAL int endbit;
6522836Smckusick LOCAL int errbit;
6622836Smckusick LOCAL int jumplab;
6722836Smckusick LOCAL int skiplab;
6822836Smckusick LOCAL int ioformatted;
6922836Smckusick LOCAL int statstruct = NO;
7022836Smckusick LOCAL ftnint blklen;
7122836Smckusick 
7222836Smckusick LOCAL offsetlist *mkiodata();
7322836Smckusick 
7422836Smckusick 
7522836Smckusick #define UNFORMATTED 0
7622836Smckusick #define FORMATTED 1
7722836Smckusick #define LISTDIRECTED 2
7822836Smckusick #define NAMEDIRECTED 3
7922836Smckusick 
8022836Smckusick #define V(z)	ioc[z].iocval
8122836Smckusick 
8222836Smckusick #define IOALL 07777
8322836Smckusick 
8422836Smckusick LOCAL struct Ioclist
8522836Smckusick 	{
8622836Smckusick 	char *iocname;
8722836Smckusick 	int iotype;
8822836Smckusick 	expptr iocval;
8922836Smckusick 	} ioc[ ] =
9022836Smckusick 	{
9122836Smckusick 		{ "", 0 },
9222836Smckusick 		{ "unit", IOALL },
9322836Smckusick 		{ "fmt", M(IOREAD) | M(IOWRITE) },
9422836Smckusick 		{ "err", IOALL },
9522836Smckusick 		{ "end", M(IOREAD) },
9622836Smckusick 		{ "iostat", IOALL },
9722836Smckusick 		{ "rec", M(IOREAD) | M(IOWRITE) },
9822836Smckusick 		{ "recl", M(IOOPEN) | M(IOINQUIRE) },
9922836Smckusick 		{ "file", M(IOOPEN) | M(IOINQUIRE) },
10022836Smckusick 		{ "status", M(IOOPEN) | M(IOCLOSE) },
10122836Smckusick 		{ "access", M(IOOPEN) | M(IOINQUIRE) },
10222836Smckusick 		{ "form", M(IOOPEN) | M(IOINQUIRE) },
10322836Smckusick 		{ "blank", M(IOOPEN) | M(IOINQUIRE) },
10422836Smckusick 		{ "exist", M(IOINQUIRE) },
10522836Smckusick 		{ "opened", M(IOINQUIRE) },
10622836Smckusick 		{ "number", M(IOINQUIRE) },
10722836Smckusick 		{ "named", M(IOINQUIRE) },
10822836Smckusick 		{ "name", M(IOINQUIRE) },
10922836Smckusick 		{ "sequential", M(IOINQUIRE) },
11022836Smckusick 		{ "direct", M(IOINQUIRE) },
11122836Smckusick 		{ "formatted", M(IOINQUIRE) },
11222836Smckusick 		{ "unformatted", M(IOINQUIRE) },
11322836Smckusick 		{ "nextrec", M(IOINQUIRE) }
11422836Smckusick 	} ;
11522836Smckusick 
11622836Smckusick #define NIOS (sizeof(ioc)/sizeof(struct Ioclist) - 1)
11722836Smckusick #define MAXIO	SZFLAG + 10*SZIOINT + 15*SZADDR
11822836Smckusick 
11922836Smckusick #define IOSUNIT 1
12022836Smckusick #define IOSFMT 2
12122836Smckusick #define IOSERR 3
12222836Smckusick #define IOSEND 4
12322836Smckusick #define IOSIOSTAT 5
12422836Smckusick #define IOSREC 6
12522836Smckusick #define IOSRECL 7
12622836Smckusick #define IOSFILE 8
12722836Smckusick #define IOSSTATUS 9
12822836Smckusick #define IOSACCESS 10
12922836Smckusick #define IOSFORM 11
13022836Smckusick #define IOSBLANK 12
13122836Smckusick #define IOSEXISTS 13
13222836Smckusick #define IOSOPENED 14
13322836Smckusick #define IOSNUMBER 15
13422836Smckusick #define IOSNAMED 16
13522836Smckusick #define IOSNAME 17
13622836Smckusick #define IOSSEQUENTIAL 18
13722836Smckusick #define IOSDIRECT 19
13822836Smckusick #define IOSFORMATTED 20
13922836Smckusick #define IOSUNFORMATTED 21
14022836Smckusick #define IOSNEXTREC 22
14122836Smckusick 
14222836Smckusick #define IOSTP V(IOSIOSTAT)
14322836Smckusick 
14422836Smckusick 
14522836Smckusick /* offsets in generated structures */
14622836Smckusick 
14722836Smckusick #define SZFLAG SZIOINT
14822836Smckusick 
14922836Smckusick /* offsets for external READ and WRITE statements */
15022836Smckusick 
15122836Smckusick #define XERR 0
15222836Smckusick #define XUNIT	SZFLAG
15322836Smckusick #define XEND	SZFLAG + SZIOINT
15422836Smckusick #define XFMT	2*SZFLAG + SZIOINT
15522836Smckusick #define XREC	2*SZFLAG + SZIOINT + SZADDR
15622836Smckusick #define XRLEN	2*SZFLAG + 2*SZADDR
15722836Smckusick #define XRNUM	2*SZFLAG + 2*SZADDR + SZIOINT
15822836Smckusick 
15922836Smckusick /* offsets for internal READ and WRITE statements */
16022836Smckusick 
16122836Smckusick #define XIERR	0
16222836Smckusick #define XIUNIT	SZFLAG
16322836Smckusick #define XIEND	SZFLAG + SZADDR
16422836Smckusick #define XIFMT	2*SZFLAG + SZADDR
16522836Smckusick #define XIRLEN	2*SZFLAG + 2*SZADDR
16622836Smckusick #define XIRNUM	2*SZFLAG + 2*SZADDR + SZIOINT
16722836Smckusick #define XIREC	2*SZFLAG + 2*SZADDR + 2*SZIOINT
16822836Smckusick 
16922836Smckusick /* offsets for OPEN statements */
17022836Smckusick 
17122836Smckusick #define XFNAME	SZFLAG + SZIOINT
17222836Smckusick #define XFNAMELEN	SZFLAG + SZIOINT + SZADDR
17322836Smckusick #define XSTATUS	SZFLAG + 2*SZIOINT + SZADDR
17422836Smckusick #define XACCESS	SZFLAG + 2*SZIOINT + 2*SZADDR
17522836Smckusick #define XFORMATTED	SZFLAG + 2*SZIOINT + 3*SZADDR
17622836Smckusick #define XRECLEN	SZFLAG + 2*SZIOINT + 4*SZADDR
17722836Smckusick #define XBLANK	SZFLAG + 3*SZIOINT + 4*SZADDR
17822836Smckusick 
17922836Smckusick /* offset for CLOSE statement */
18022836Smckusick 
18122836Smckusick #define XCLSTATUS	SZFLAG + SZIOINT
18222836Smckusick 
18322836Smckusick /* offsets for INQUIRE statement */
18422836Smckusick 
18522836Smckusick #define XFILE	SZFLAG + SZIOINT
18622836Smckusick #define XFILELEN	SZFLAG + SZIOINT + SZADDR
18722836Smckusick #define XEXISTS	SZFLAG + 2*SZIOINT + SZADDR
18822836Smckusick #define XOPEN	SZFLAG + 2*SZIOINT + 2*SZADDR
18922836Smckusick #define XNUMBER	SZFLAG + 2*SZIOINT + 3*SZADDR
19022836Smckusick #define XNAMED	SZFLAG + 2*SZIOINT + 4*SZADDR
19122836Smckusick #define XNAME	SZFLAG + 2*SZIOINT + 5*SZADDR
19222836Smckusick #define XNAMELEN	SZFLAG + 2*SZIOINT + 6*SZADDR
19322836Smckusick #define XQACCESS	SZFLAG + 3*SZIOINT + 6*SZADDR
19422836Smckusick #define XQACCLEN	SZFLAG + 3*SZIOINT + 7*SZADDR
19522836Smckusick #define XSEQ	SZFLAG + 4*SZIOINT + 7*SZADDR
19622836Smckusick #define XSEQLEN	SZFLAG + 4*SZIOINT + 8*SZADDR
19722836Smckusick #define XDIRECT	SZFLAG + 5*SZIOINT + 8*SZADDR
19822836Smckusick #define XDIRLEN	SZFLAG + 5*SZIOINT + 9*SZADDR
19922836Smckusick #define XFORM	SZFLAG + 6*SZIOINT + 9*SZADDR
20022836Smckusick #define XFORMLEN	SZFLAG + 6*SZIOINT + 10*SZADDR
20122836Smckusick #define XFMTED	SZFLAG + 7*SZIOINT + 10*SZADDR
20222836Smckusick #define XFMTEDLEN	SZFLAG + 7*SZIOINT + 11*SZADDR
20322836Smckusick #define XUNFMT	SZFLAG + 8*SZIOINT + 11*SZADDR
20422836Smckusick #define XUNFMTLEN	SZFLAG + 8*SZIOINT + 12*SZADDR
20522836Smckusick #define XQRECL	SZFLAG + 9*SZIOINT + 12*SZADDR
20622836Smckusick #define XNEXTREC	SZFLAG + 9*SZIOINT + 13*SZADDR
20722836Smckusick #define XQBLANK	SZFLAG + 9*SZIOINT + 14*SZADDR
20822836Smckusick #define XQBLANKLEN	SZFLAG + 9*SZIOINT + 15*SZADDR
20922836Smckusick 
fmtstmt(lp)21022836Smckusick fmtstmt(lp)
21122836Smckusick register struct Labelblock *lp;
21222836Smckusick {
21322836Smckusick if(lp == NULL)
21422836Smckusick 	{
21522836Smckusick 	execerr("unlabeled format statement" , CNULL);
21622836Smckusick 	return(-1);
21722836Smckusick 	}
21822836Smckusick if(lp->labtype == LABUNKNOWN)
21922836Smckusick 	lp->labtype = LABFORMAT;
22022836Smckusick else if(lp->labtype != LABFORMAT)
22122836Smckusick 	{
22222836Smckusick 	execerr("bad format number", CNULL);
22322836Smckusick 	return(-1);
22422836Smckusick 	}
22522836Smckusick return(lp->labelno);
22622836Smckusick }
22722836Smckusick 
22822836Smckusick 
22922836Smckusick 
startioctl()23022836Smckusick startioctl()
23122836Smckusick {
23222836Smckusick register int i;
23322836Smckusick 
23422836Smckusick inioctl = YES;
23522836Smckusick nioctl = 0;
23622836Smckusick ioformatted = UNFORMATTED;
23722836Smckusick for(i = 1 ; i<=NIOS ; ++i)
23822836Smckusick 	V(i) = NULL;
23922836Smckusick }
24022836Smckusick 
24122836Smckusick 
24222836Smckusick 
endioctl()24322836Smckusick endioctl()
24422836Smckusick {
24522836Smckusick int i;
24622836Smckusick expptr p;
24722836Smckusick 
24822836Smckusick inioctl = NO;
24922836Smckusick 
25022836Smckusick /* set up for error recovery */
25122836Smckusick 
25222836Smckusick ioerrlab = ioendlab = skiplab = jumplab = 0;
25322836Smckusick 
25422836Smckusick if(p = V(IOSEND))
25522836Smckusick 	if(ISICON(p))
25633257Sbostic 		ioendlab = execlab(p->constblock.constant.ci) ->labelno;
25722836Smckusick 	else
25822836Smckusick 		err("bad end= clause");
25922836Smckusick 
26022836Smckusick if(p = V(IOSERR))
26122836Smckusick 	if(ISICON(p))
26233257Sbostic 		ioerrlab = execlab(p->constblock.constant.ci) ->labelno;
26322836Smckusick 	else
26422836Smckusick 		err("bad err= clause");
26522836Smckusick 
26622836Smckusick if(IOSTP)
26722836Smckusick 	if(IOSTP->tag!=TADDR || ! ISINT(IOSTP->addrblock.vtype) )
26822836Smckusick 		{
26922836Smckusick 		err("iostat must be an integer variable");
27022836Smckusick 		frexpr(IOSTP);
27122836Smckusick 		IOSTP = NULL;
27222836Smckusick 		}
27322836Smckusick 
27422836Smckusick if(iostmt == IOREAD)
27522836Smckusick 	{
27622836Smckusick 	if(IOSTP)
27722836Smckusick 		{
27822836Smckusick 		if(ioerrlab && ioendlab && ioerrlab==ioendlab)
27922836Smckusick 			jumplab = ioerrlab;
28022836Smckusick 		else
28122836Smckusick 			skiplab = jumplab = newlabel();
28222836Smckusick 		}
28322836Smckusick 	else	{
28422836Smckusick 		if(ioerrlab && ioendlab && ioerrlab!=ioendlab)
28522836Smckusick 			{
28622836Smckusick 			IOSTP = (expptr) mktemp(TYINT, PNULL);
28722836Smckusick 			skiplab = jumplab = newlabel();
28822836Smckusick 			}
28922836Smckusick 		else
29022836Smckusick 			jumplab = (ioerrlab ? ioerrlab : ioendlab);
29122836Smckusick 		}
29222836Smckusick 	}
29322836Smckusick else if(iostmt == IOWRITE)
29422836Smckusick 	{
29522836Smckusick 	if(IOSTP && !ioerrlab)
29622836Smckusick 		skiplab = jumplab = newlabel();
29722836Smckusick 	else
29822836Smckusick 		jumplab = ioerrlab;
29922836Smckusick 	}
30022836Smckusick else
30122836Smckusick 	jumplab = ioerrlab;
30222836Smckusick 
30322836Smckusick endbit = IOSTP!=NULL || ioendlab!=0;	/* for use in startrw() */
30422836Smckusick errbit = IOSTP!=NULL || ioerrlab!=0;
30522836Smckusick if(iostmt!=IOREAD && iostmt!=IOWRITE)
30622836Smckusick 	{
30722836Smckusick 	if(ioblkp == NULL)
30822836Smckusick 		ioblkp = autovar( (MAXIO+SZIOINT-1)/SZIOINT , TYIOINT, PNULL);
30922836Smckusick 	ioset(TYIOINT, XERR, ICON(errbit));
31022836Smckusick 	}
31122836Smckusick 
31222836Smckusick switch(iostmt)
31322836Smckusick 	{
31422836Smckusick 	case IOOPEN:
31522836Smckusick 		dofopen();  break;
31622836Smckusick 
31722836Smckusick 	case IOCLOSE:
31822836Smckusick 		dofclose();  break;
31922836Smckusick 
32022836Smckusick 	case IOINQUIRE:
32122836Smckusick 		dofinquire();  break;
32222836Smckusick 
32322836Smckusick 	case IOBACKSPACE:
32422836Smckusick 		dofmove("f_back"); break;
32522836Smckusick 
32622836Smckusick 	case IOREWIND:
32722836Smckusick 		dofmove("f_rew");  break;
32822836Smckusick 
32922836Smckusick 	case IOENDFILE:
33022836Smckusick 		dofmove("f_end");  break;
33122836Smckusick 
33222836Smckusick 	case IOREAD:
33322836Smckusick 	case IOWRITE:
33422836Smckusick 		startrw();  break;
33522836Smckusick 
33622836Smckusick 	default:
33722836Smckusick 		fatali("impossible iostmt %d", iostmt);
33822836Smckusick 	}
33922836Smckusick for(i = 1 ; i<=NIOS ; ++i)
34022836Smckusick 	if(i!=IOSIOSTAT && V(i)!=NULL)
34122836Smckusick 		frexpr(V(i));
34222836Smckusick }
34322836Smckusick 
34422836Smckusick 
34522836Smckusick 
iocname()34622836Smckusick iocname()
34722836Smckusick {
34822836Smckusick register int i;
34922836Smckusick int found, mask;
35022836Smckusick 
35122836Smckusick found = 0;
35222836Smckusick mask = M(iostmt);
35322836Smckusick for(i = 1 ; i <= NIOS ; ++i)
35422836Smckusick 	if(toklen==strlen(ioc[i].iocname) && eqn(toklen, token, ioc[i].iocname))
35522836Smckusick 		if(ioc[i].iotype & mask)
35622836Smckusick 			return(i);
35722836Smckusick 		else	found = i;
35822836Smckusick if(found)
35922836Smckusick 	errstr("invalid control %s for statement", ioc[found].iocname);
36022836Smckusick else
36122836Smckusick 	errstr("unknown iocontrol %s", varstr(toklen, token) );
36222836Smckusick return(IOSBAD);
36322836Smckusick }
36422836Smckusick 
36522836Smckusick 
ioclause(n,p)36622836Smckusick ioclause(n, p)
36722836Smckusick register int n;
36822836Smckusick register expptr p;
36922836Smckusick {
37022836Smckusick struct Ioclist *iocp;
37122836Smckusick 
37222836Smckusick ++nioctl;
37322836Smckusick if(n == IOSBAD)
37422836Smckusick 	return;
37522836Smckusick if(n == IOSPOSITIONAL)
37622836Smckusick 	{
37725741Sdonn 	if(nioctl > IOSFMT ||
37825741Sdonn 	   nioctl > IOSUNIT && !(iostmt == IOREAD || iostmt == IOWRITE))
37922836Smckusick 		{
38022836Smckusick 		err("illegal positional iocontrol");
38122836Smckusick 		return;
38222836Smckusick 		}
38322836Smckusick 	n = nioctl;
38422836Smckusick 	}
38522836Smckusick 
38622836Smckusick if(p == NULL)
38722836Smckusick 	{
38822836Smckusick 	if(n == IOSUNIT)
38922836Smckusick 		p = (expptr) (iostmt==IOREAD ? IOSTDIN : IOSTDOUT);
39022836Smckusick 	else if(n != IOSFMT)
39122836Smckusick 		{
39222836Smckusick 		err("illegal * iocontrol");
39322836Smckusick 		return;
39422836Smckusick 		}
39522836Smckusick 	}
39622836Smckusick if(n == IOSFMT)
39722836Smckusick 	ioformatted = (p==NULL ? LISTDIRECTED : FORMATTED);
39822836Smckusick 
39922836Smckusick iocp = & ioc[n];
40022836Smckusick if(iocp->iocval == NULL)
40122836Smckusick 	{
40222836Smckusick 	p = (expptr) cpexpr(p);
40322836Smckusick 	if(n!=IOSFMT && ( n!=IOSUNIT || (p!=NULL && p->headblock.vtype!=TYCHAR) ) )
40422836Smckusick 		p = fixtype(p);
40522836Smckusick 	if(p!=NULL && ISCONST(p) && p->constblock.vtype==TYCHAR)
40622836Smckusick 		p = (expptr) putconst(p);
40722836Smckusick 	iocp->iocval = p;
40822836Smckusick }
40922836Smckusick else
41022836Smckusick 	errstr("iocontrol %s repeated", iocp->iocname);
41122836Smckusick }
41222836Smckusick 
41322836Smckusick /* io list item */
41422836Smckusick 
doio(list)41522836Smckusick doio(list)
41622836Smckusick chainp list;
41722836Smckusick {
41822836Smckusick expptr call0();
41922836Smckusick 
42022836Smckusick if(ioformatted == NAMEDIRECTED)
42122836Smckusick 	{
42222836Smckusick 	if(list)
42322836Smckusick 		err("no I/O list allowed in NAMELIST read/write");
42422836Smckusick 	}
42522836Smckusick else
42622836Smckusick 	{
42722836Smckusick 	doiolist(list);
42822836Smckusick 	ioroutine[0] = 'e';
42922836Smckusick 	putiocall( call0(TYINT, ioroutine) );
43022836Smckusick 	}
43122836Smckusick }
43222836Smckusick 
43322836Smckusick 
43422836Smckusick 
43522836Smckusick 
43622836Smckusick 
doiolist(p0)43722836Smckusick LOCAL doiolist(p0)
43822836Smckusick chainp p0;
43922836Smckusick {
44022836Smckusick chainp p;
44122836Smckusick register tagptr q;
44222836Smckusick register expptr qe;
44322836Smckusick register Namep qn;
44422836Smckusick Addrp tp, mkscalar();
44522836Smckusick int range;
44622836Smckusick expptr expr;
44722836Smckusick 
44822836Smckusick for (p = p0 ; p ; p = p->nextp)
44922836Smckusick 	{
45022836Smckusick 	q = p->datap;
45122836Smckusick 	if(q->tag == TIMPLDO)
45222836Smckusick 		{
45322836Smckusick 		exdo(range=newlabel(), q->impldoblock.impdospec);
45422836Smckusick 		doiolist(q->impldoblock.datalist);
45522836Smckusick 		enddo(range);
45622836Smckusick 		free( (charptr) q);
45722836Smckusick 		}
45822836Smckusick 	else	{
45922836Smckusick 		if(q->tag==TPRIM && q->primblock.argsp==NULL
46022836Smckusick 		    && q->primblock.namep->vdim!=NULL)
46122836Smckusick 			{
46222836Smckusick 			vardcl(qn = q->primblock.namep);
46322836Smckusick 			if(qn->vdim->nelt)
46422836Smckusick 				putio( fixtype(cpexpr(qn->vdim->nelt)),
46522836Smckusick 					mkscalar(qn) );
46622836Smckusick 			else
46722836Smckusick 				err("attempt to i/o array of unknown size");
46822836Smckusick 			}
46922836Smckusick 		else if(q->tag==TPRIM && q->primblock.argsp==NULL &&
47022836Smckusick 		    (qe = (expptr) memversion(q->primblock.namep)) )
47122836Smckusick 			putio(ICON(1),qe);
47222836Smckusick 		else if( (qe = fixtype(cpexpr(q)))->tag==TADDR)
47322836Smckusick 			putio(ICON(1), qe);
47422836Smckusick 		else if(qe->headblock.vtype != TYERROR)
47522836Smckusick 			{
47622836Smckusick 			if(iostmt == IOWRITE)
47722836Smckusick 				{
47822836Smckusick 				ftnint lencat();
47922836Smckusick 				expptr qvl;
48022836Smckusick 				qvl = NULL;
48122836Smckusick 				if( ISCHAR(qe) )
48222836Smckusick 					{
48322836Smckusick 					qvl = (expptr)
48422836Smckusick 						cpexpr(qe->headblock.vleng);
48522836Smckusick 					tp = mktemp(qe->headblock.vtype,
48622836Smckusick 						     ICON(lencat(qe)));
48722836Smckusick 					}
48822836Smckusick 				else
48922836Smckusick 					tp = mktemp(qe->headblock.vtype,
49022836Smckusick 						qe->headblock.vleng);
49122836Smckusick 				if (optimflag)
49222836Smckusick 					{
49322836Smckusick 					expr = mkexpr(OPASSIGN,cpexpr(tp),qe);
49422836Smckusick 					optbuff (SKEQ,expr,0,0);
49522836Smckusick 					}
49622836Smckusick 				else
49722836Smckusick 					puteq (cpexpr(tp),qe);
49822836Smckusick 				if(qvl)	/* put right length on block */
49922836Smckusick 					{
50022836Smckusick 					frexpr(tp->vleng);
50122836Smckusick 					tp->vleng = qvl;
50222836Smckusick 					}
50322836Smckusick 				putio(ICON(1), tp);
50422836Smckusick 				}
50522836Smckusick 			else
50622836Smckusick 				err("non-left side in READ list");
50722836Smckusick 			}
50822836Smckusick 		frexpr(q);
50922836Smckusick 		}
51022836Smckusick 	}
51122836Smckusick frchain( &p0 );
51222836Smckusick }
51322836Smckusick 
51422836Smckusick 
51522836Smckusick 
51622836Smckusick 
51722836Smckusick 
putio(nelt,addr)51822836Smckusick LOCAL putio(nelt, addr)
51922836Smckusick expptr nelt;
52022836Smckusick register expptr addr;
52122836Smckusick {
52222836Smckusick int type;
52322836Smckusick register expptr q;
52422836Smckusick 
52522836Smckusick type = addr->headblock.vtype;
52622836Smckusick if(ioformatted!=LISTDIRECTED && ISCOMPLEX(type) )
52722836Smckusick 	{
52822836Smckusick 	nelt = mkexpr(OPSTAR, ICON(2), nelt);
52922836Smckusick 	type -= (TYCOMPLEX-TYREAL);
53022836Smckusick 	}
53122836Smckusick 
53222836Smckusick /* pass a length with every item.  for noncharacter data, fake one */
53322836Smckusick if(type != TYCHAR)
53422836Smckusick 	{
53522836Smckusick 	addr->headblock.vtype = TYCHAR;
53622836Smckusick 	addr->headblock.vleng = ICON( typesize[type] );
53722836Smckusick 	}
53822836Smckusick 
53922836Smckusick nelt = fixtype( mkconv(TYLENG,nelt) );
54022836Smckusick if(ioformatted == LISTDIRECTED)
54122836Smckusick 	q = call3(TYINT, "do_lio", mkconv(TYLONG, ICON(type)), nelt, addr);
54222836Smckusick else
54322836Smckusick 	q = call2(TYINT, (ioformatted==FORMATTED ? "do_fio" : "do_uio"),
54422836Smckusick 		nelt, addr);
54522836Smckusick putiocall(q);
54622836Smckusick }
54722836Smckusick 
54822836Smckusick 
54922836Smckusick 
55022836Smckusick 
endio()55122836Smckusick endio()
55222836Smckusick {
55322836Smckusick if(skiplab)
55422836Smckusick 	{
55522836Smckusick 	if (optimflag)
55622836Smckusick 		optbuff (SKLABEL, 0, skiplab, 0);
55722836Smckusick 	else
55822836Smckusick 		putlabel (skiplab);
55922836Smckusick 	if(ioendlab)
56022836Smckusick 		{
56122836Smckusick 		expptr test;
56222836Smckusick 		test = mkexpr(OPGE, cpexpr(IOSTP), ICON(0));
56322836Smckusick 		if (optimflag)
56422836Smckusick 			optbuff (SKIOIFN,test,ioendlab,0);
56522836Smckusick 		else
56622836Smckusick 			putif (test,ioendlab);
56722836Smckusick 		}
56822836Smckusick 	if(ioerrlab)
56922836Smckusick 		{
57022836Smckusick 		expptr test;
57122836Smckusick 		test = mkexpr
57222836Smckusick 			( ((iostmt==IOREAD||iostmt==IOWRITE) ? OPLE : OPEQ),
57322836Smckusick 			cpexpr(IOSTP), ICON(0));
57422836Smckusick 		if (optimflag)
57522836Smckusick 			optbuff (SKIOIFN,test,ioerrlab,0);
57622836Smckusick 		else
57722836Smckusick 			putif (test,ioerrlab);
57822836Smckusick 		}
57922836Smckusick 	}
58022836Smckusick if(IOSTP)
58122836Smckusick 	frexpr(IOSTP);
58222836Smckusick }
58322836Smckusick 
58422836Smckusick 
58522836Smckusick 
putiocall(q)58622836Smckusick LOCAL putiocall(q)
58722836Smckusick register expptr q;
58822836Smckusick {
58922836Smckusick if(IOSTP)
59022836Smckusick 	{
59122836Smckusick 	q->headblock.vtype = TYINT;
59222836Smckusick 	q = fixexpr( mkexpr(OPASSIGN, cpexpr(IOSTP), q));
59322836Smckusick 	}
59422836Smckusick 
59522836Smckusick if(jumplab)
59622836Smckusick 	if (optimflag)
59722836Smckusick 		optbuff (SKIOIFN,mkexpr(OPEQ,q,ICON(0)),jumplab,0);
59822836Smckusick 	else
59922836Smckusick 		putif (mkexpr(OPEQ,q,ICON(0)),jumplab);
60022836Smckusick else
60122836Smckusick 	if (optimflag)
60222836Smckusick 		optbuff (SKEQ, q, 0, 0);
60322836Smckusick 	else
60422836Smckusick 		putexpr(q);
60522836Smckusick }
60622836Smckusick 
startrw()60722836Smckusick startrw()
60822836Smckusick {
60922836Smckusick register expptr p;
61022836Smckusick register Namep np;
61122836Smckusick register Addrp unitp, fmtp, recp, tioblkp;
61222836Smckusick register expptr nump;
61322836Smckusick register ioblock *t;
61422836Smckusick Addrp mkscalar();
61522836Smckusick expptr mkaddcon();
61622836Smckusick int k;
61722836Smckusick flag intfile, sequential, ok, varfmt;
61822836Smckusick 
61922836Smckusick /* First look at all the parameters and determine what is to be done */
62022836Smckusick 
62122836Smckusick ok = YES;
62222836Smckusick statstruct = YES;
62322836Smckusick 
62422836Smckusick intfile = NO;
62522836Smckusick if(p = V(IOSUNIT))
62622836Smckusick 	{
62722836Smckusick 	if( ISINT(p->headblock.vtype) )
62822836Smckusick 		unitp = (Addrp) cpexpr(p);
62922836Smckusick 	else if(p->headblock.vtype == TYCHAR)
63022836Smckusick 		{
63122836Smckusick 		intfile = YES;
63222836Smckusick 		if(p->tag==TPRIM && p->primblock.argsp==NULL &&
63322836Smckusick 		    (np = p->primblock.namep)->vdim!=NULL)
63422836Smckusick 			{
63522836Smckusick 			vardcl(np);
63622836Smckusick 			if(np->vdim->nelt)
63722836Smckusick 				{
63822836Smckusick 				nump = (expptr) cpexpr(np->vdim->nelt);
63922836Smckusick 				if( ! ISCONST(nump) )
64022836Smckusick 					statstruct = NO;
64122836Smckusick 				}
64222836Smckusick 			else
64322836Smckusick 				{
64422836Smckusick 				err("attempt to use internal unit array of unknown size");
64522836Smckusick 				ok = NO;
64622836Smckusick 				nump = ICON(1);
64722836Smckusick 				}
64822836Smckusick 			unitp = mkscalar(np);
64922836Smckusick 			}
65022836Smckusick 		else	{
65122836Smckusick 			nump = ICON(1);
65222836Smckusick 			unitp = (Addrp) fixtype(cpexpr(p));
65322836Smckusick 			}
65422836Smckusick 		if(! isstatic(unitp) )
65522836Smckusick 			statstruct = NO;
65622836Smckusick 		}
65722836Smckusick 	else
65822836Smckusick 		{
65922836Smckusick 		err("bad unit specifier type");
66022836Smckusick 		ok = NO;
66122836Smckusick 		}
66222836Smckusick 	}
66322836Smckusick else
66422836Smckusick 	{
66522836Smckusick 	err("bad unit specifier");
66622836Smckusick 	ok = NO;
66722836Smckusick 	}
66822836Smckusick 
66922836Smckusick sequential = YES;
67022836Smckusick if(p = V(IOSREC))
67122836Smckusick 	if( ISINT(p->headblock.vtype) )
67222836Smckusick 		{
67322836Smckusick 		recp = (Addrp) cpexpr(p);
67422836Smckusick 		sequential = NO;
67522836Smckusick 		}
67622836Smckusick 	else	{
67722836Smckusick 		err("bad REC= clause");
67822836Smckusick 		ok = NO;
67922836Smckusick 		}
68022836Smckusick else
68122836Smckusick 	recp = NULL;
68222836Smckusick 
68322836Smckusick 
68422836Smckusick varfmt = YES;
68522836Smckusick fmtp = NULL;
68622836Smckusick if(p = V(IOSFMT))
68722836Smckusick 	{
68822836Smckusick 	if(p->tag==TPRIM && p->primblock.argsp==NULL)
68922836Smckusick 		{
69022836Smckusick 		np = p->primblock.namep;
69122836Smckusick 		if(np->vclass == CLNAMELIST)
69222836Smckusick 			{
69322836Smckusick 			ioformatted = NAMEDIRECTED;
69422836Smckusick 			fmtp = (Addrp) fixtype(cpexpr(p));
69522836Smckusick 			goto endfmt;
69622836Smckusick 			}
69722836Smckusick 		vardcl(np);
69822836Smckusick 		if(np->vdim)
69922836Smckusick 			{
70022836Smckusick 			if( ! ONEOF(np->vstg, MSKSTATIC) )
70122836Smckusick 				statstruct = NO;
70222836Smckusick 			fmtp = mkscalar(np);
70322836Smckusick 			goto endfmt;
70422836Smckusick 			}
70522836Smckusick 		if( ISINT(np->vtype) )	/* ASSIGNed label */
70622836Smckusick 			{
70722836Smckusick 			statstruct = NO;
70822836Smckusick 			varfmt = NO;
70922836Smckusick 			fmtp = (Addrp) fixtype(cpexpr(p));
71022836Smckusick 			goto endfmt;
71122836Smckusick 			}
71222836Smckusick 		}
71322836Smckusick 	p = V(IOSFMT) = fixtype(p);
71422836Smckusick 	if(p->headblock.vtype == TYCHAR)
71522836Smckusick 		{
71622836Smckusick 		if (p->tag == TCONST) p = (expptr) putconst(p);
71722836Smckusick 		if( ! isstatic(p) )
71822836Smckusick 			statstruct = NO;
71922836Smckusick 		fmtp = (Addrp) cpexpr(p);
72022836Smckusick 		}
72122836Smckusick 	else if( ISICON(p) )
72222836Smckusick 		{
72333257Sbostic 		if( (k = fmtstmt( mklabel(p->constblock.constant.ci) )) > 0 )
72422836Smckusick 			{
72522836Smckusick 			fmtp = (Addrp) mkaddcon(k);
72622836Smckusick 			varfmt = NO;
72722836Smckusick 			}
72822836Smckusick 		else
72922836Smckusick 			ioformatted = UNFORMATTED;
73022836Smckusick 		}
73122836Smckusick 	else	{
73222836Smckusick 		err("bad format descriptor");
73322836Smckusick 		ioformatted = UNFORMATTED;
73422836Smckusick 		ok = NO;
73522836Smckusick 		}
73622836Smckusick 	}
73722836Smckusick else
73822836Smckusick 	fmtp = NULL;
73922836Smckusick 
74022836Smckusick endfmt:
74122836Smckusick 	if(intfile && ioformatted==UNFORMATTED)
74222836Smckusick 		{
74322836Smckusick 		err("unformatted internal I/O not allowed");
74422836Smckusick 		ok = NO;
74522836Smckusick 		}
74622836Smckusick 	if(!sequential && ioformatted==LISTDIRECTED)
74722836Smckusick 		{
74822836Smckusick 		err("direct list-directed I/O not allowed");
74922836Smckusick 		ok = NO;
75022836Smckusick 		}
75122836Smckusick 	if(!sequential && ioformatted==NAMEDIRECTED)
75222836Smckusick 		{
75322836Smckusick 		err("direct namelist I/O not allowed");
75422836Smckusick 		ok = NO;
75522836Smckusick 		}
75622836Smckusick 
75722836Smckusick if( ! ok )
75822836Smckusick 	return;
75922836Smckusick 
76022836Smckusick if (optimflag && ISCONST (fmtp))
76122836Smckusick 	fmtp = putconst ( (expptr) fmtp);
76222836Smckusick 
76322836Smckusick /*
76422836Smckusick    Now put out the I/O structure, statically if all the clauses
76522836Smckusick    are constants, dynamically otherwise
76622836Smckusick */
76722836Smckusick 
76822836Smckusick if(statstruct)
76922836Smckusick 	{
77022836Smckusick 	tioblkp = ioblkp;
77122836Smckusick 	ioblkp = ALLOC(Addrblock);
77222836Smckusick 	ioblkp->tag = TADDR;
77322836Smckusick 	ioblkp->vtype = TYIOINT;
77422836Smckusick 	ioblkp->vclass = CLVAR;
77522836Smckusick 	ioblkp->vstg = STGINIT;
77622836Smckusick 	ioblkp->memno = ++lastvarno;
77722836Smckusick 	ioblkp->memoffset = ICON(0);
77822836Smckusick 	blklen = (intfile ? XIREC+SZIOINT :
77922836Smckusick 			(sequential ? XFMT+SZADDR : XRNUM+SZIOINT) );
78022836Smckusick 	t = ALLOC(IoBlock);
78122836Smckusick 	t->blkno = ioblkp->memno;
78222836Smckusick 	t->len = blklen;
78322836Smckusick 	t->next = iodata;
78422836Smckusick 	iodata = t;
78522836Smckusick 	}
78622836Smckusick else if(ioblkp == NULL)
78722836Smckusick 	ioblkp = autovar( (MAXIO+SZIOINT-1)/SZIOINT , TYIOINT, PNULL);
78822836Smckusick 
78922836Smckusick ioset(TYIOINT, XERR, ICON(errbit));
79022836Smckusick if(iostmt == IOREAD)
79122836Smckusick 	ioset(TYIOINT, (intfile ? XIEND : XEND), ICON(endbit) );
79222836Smckusick 
79322836Smckusick if(intfile)
79422836Smckusick 	{
79522836Smckusick 	ioset(TYIOINT, XIRNUM, nump);
79626511Sdonn 	ioseta(XIUNIT, cpexpr(unitp));
79722836Smckusick 	ioset(TYIOINT, XIRLEN, cpexpr(unitp->vleng) );
79826511Sdonn 	frexpr(unitp);
79922836Smckusick 	}
80022836Smckusick else
80122836Smckusick 	ioset(TYIOINT, XUNIT, (expptr) unitp);
80222836Smckusick 
80322836Smckusick if(recp)
80422836Smckusick 	ioset(TYIOINT, (intfile ? XIREC : XREC) , (expptr) recp);
80522836Smckusick 
80622836Smckusick if(varfmt)
80722836Smckusick 	ioseta( intfile ? XIFMT : XFMT , fmtp);
80822836Smckusick else
80922836Smckusick 	ioset(TYADDR, intfile ? XIFMT : XFMT, (expptr) fmtp);
81022836Smckusick 
81122836Smckusick ioroutine[0] = 's';
81222836Smckusick ioroutine[1] = '_';
81322836Smckusick ioroutine[2] = (iostmt==IOREAD ? 'r' : 'w');
81422836Smckusick ioroutine[3] = (sequential ? 's' : 'd');
81522836Smckusick ioroutine[4] = "ufln" [ioformatted];
81622836Smckusick ioroutine[5] = (intfile ? 'i' : 'e');
81722836Smckusick ioroutine[6] = '\0';
81822836Smckusick 
81922836Smckusick putiocall( call1(TYINT, ioroutine, cpexpr(ioblkp) ));
82022836Smckusick 
82122836Smckusick if(statstruct)
82222836Smckusick 	{
82322836Smckusick 	frexpr(ioblkp);
82422836Smckusick 	ioblkp = tioblkp;
82522836Smckusick 	statstruct = NO;
82622836Smckusick 	}
82722836Smckusick }
82822836Smckusick 
82922836Smckusick 
83022836Smckusick 
dofopen()83122836Smckusick LOCAL dofopen()
83222836Smckusick {
83322836Smckusick register expptr p;
83422836Smckusick 
83522836Smckusick if( (p = V(IOSUNIT)) && ISINT(p->headblock.vtype) )
83622836Smckusick 	ioset(TYIOINT, XUNIT, cpexpr(p) );
83722836Smckusick else
83822836Smckusick 	err("bad unit in open");
83922836Smckusick if( (p = V(IOSFILE)) )
84022836Smckusick 	if(p->headblock.vtype == TYCHAR)
84122836Smckusick 		ioset(TYIOINT, XFNAMELEN, cpexpr(p->headblock.vleng) );
84222836Smckusick 	else
84322836Smckusick 		err("bad file in open");
84422836Smckusick 
84522836Smckusick iosetc(XFNAME, p);
84622836Smckusick 
84722836Smckusick if(p = V(IOSRECL))
84822836Smckusick 	if( ISINT(p->headblock.vtype) )
84922836Smckusick 		ioset(TYIOINT, XRECLEN, cpexpr(p) );
85022836Smckusick 	else
85122836Smckusick 		err("bad recl");
85222836Smckusick else
85322836Smckusick 	ioset(TYIOINT, XRECLEN, ICON(0) );
85422836Smckusick 
85522836Smckusick iosetc(XSTATUS, V(IOSSTATUS));
85622836Smckusick iosetc(XACCESS, V(IOSACCESS));
85722836Smckusick iosetc(XFORMATTED, V(IOSFORM));
85822836Smckusick iosetc(XBLANK, V(IOSBLANK));
85922836Smckusick 
86022836Smckusick putiocall( call1(TYINT, "f_open", cpexpr(ioblkp) ));
86122836Smckusick }
86222836Smckusick 
86322836Smckusick 
dofclose()86422836Smckusick LOCAL dofclose()
86522836Smckusick {
86622836Smckusick register expptr p;
86722836Smckusick 
86822836Smckusick if( (p = V(IOSUNIT)) && ISINT(p->headblock.vtype) )
86922836Smckusick 	{
87022836Smckusick 	ioset(TYIOINT, XUNIT, cpexpr(p) );
87122836Smckusick 	iosetc(XCLSTATUS, V(IOSSTATUS));
87222836Smckusick 	putiocall( call1(TYINT, "f_clos", cpexpr(ioblkp)) );
87322836Smckusick 	}
87422836Smckusick else
87522836Smckusick 	err("bad unit in close statement");
87622836Smckusick }
87722836Smckusick 
87822836Smckusick 
dofinquire()87922836Smckusick LOCAL dofinquire()
88022836Smckusick {
88122836Smckusick register expptr p;
88222836Smckusick if(p = V(IOSUNIT))
88322836Smckusick 	{
88422836Smckusick 	if( V(IOSFILE) )
88522836Smckusick 		err("inquire by unit or by file, not both");
88622836Smckusick 	ioset(TYIOINT, XUNIT, cpexpr(p) );
88722836Smckusick 	}
88822836Smckusick else if( ! V(IOSFILE) )
88922836Smckusick 	err("must inquire by unit or by file");
89022836Smckusick iosetlc(IOSFILE, XFILE, XFILELEN);
89122836Smckusick iosetip(IOSEXISTS, XEXISTS);
89222836Smckusick iosetip(IOSOPENED, XOPEN);
89322836Smckusick iosetip(IOSNUMBER, XNUMBER);
89422836Smckusick iosetip(IOSNAMED, XNAMED);
89522836Smckusick iosetlc(IOSNAME, XNAME, XNAMELEN);
89622836Smckusick iosetlc(IOSACCESS, XQACCESS, XQACCLEN);
89722836Smckusick iosetlc(IOSSEQUENTIAL, XSEQ, XSEQLEN);
89822836Smckusick iosetlc(IOSDIRECT, XDIRECT, XDIRLEN);
89922836Smckusick iosetlc(IOSFORM, XFORM, XFORMLEN);
90022836Smckusick iosetlc(IOSFORMATTED, XFMTED, XFMTEDLEN);
90122836Smckusick iosetlc(IOSUNFORMATTED, XUNFMT, XUNFMTLEN);
90222836Smckusick iosetip(IOSRECL, XQRECL);
90322836Smckusick iosetip(IOSNEXTREC, XNEXTREC);
90422836Smckusick iosetlc(IOSBLANK, XQBLANK, XQBLANKLEN);
90522836Smckusick 
90622836Smckusick putiocall( call1(TYINT,  "f_inqu", cpexpr(ioblkp) ));
90722836Smckusick }
90822836Smckusick 
90922836Smckusick 
91022836Smckusick 
dofmove(subname)91122836Smckusick LOCAL dofmove(subname)
91222836Smckusick char *subname;
91322836Smckusick {
91422836Smckusick register expptr p;
91522836Smckusick 
91622836Smckusick if( (p = V(IOSUNIT)) && ISINT(p->headblock.vtype) )
91722836Smckusick 	{
91822836Smckusick 	ioset(TYIOINT, XUNIT, cpexpr(p) );
91922836Smckusick 	putiocall( call1(TYINT, subname, cpexpr(ioblkp) ));
92022836Smckusick 	}
92122836Smckusick else
92222836Smckusick 	err("bad unit in I/O motion statement");
92322836Smckusick }
92422836Smckusick 
92522836Smckusick 
92622836Smckusick 
92722836Smckusick LOCAL
ioset(type,offset,p)92822836Smckusick ioset(type, offset, p)
92922836Smckusick int type;
93022836Smckusick int offset;
93122836Smckusick register expptr p;
93222836Smckusick {
93322836Smckusick   static char *badoffset = "badoffset in ioset";
93422836Smckusick 
93522836Smckusick   register Addrp q;
93622836Smckusick   register offsetlist *op;
93722836Smckusick 
93822836Smckusick   q = (Addrp) cpexpr(ioblkp);
93922836Smckusick   q->vtype = type;
94022836Smckusick   q->memoffset = fixtype( mkexpr(OPPLUS, q->memoffset, ICON(offset)) );
94122836Smckusick 
94222836Smckusick   if (statstruct && ISCONST(p))
94322836Smckusick     {
94422836Smckusick       if (!ISICON(q->memoffset))
94522836Smckusick 	fatal(badoffset);
94622836Smckusick 
94733257Sbostic       op = mkiodata(q->memno, q->memoffset->constblock.constant.ci, blklen);
94822836Smckusick       if (op->tag != 0)
94922836Smckusick 	fatal(badoffset);
95022836Smckusick 
95122836Smckusick       if (type == TYADDR)
95222836Smckusick 	{
95322836Smckusick 	  op->tag = NDLABEL;
95433257Sbostic 	  op->val.label = p->constblock.constant.ci;
95522836Smckusick 	}
95622836Smckusick       else
95722836Smckusick 	{
95822836Smckusick 	  op->tag = NDDATA;
95922836Smckusick 	  op->val.cp = (Constp) convconst(type, 0, p);
96022836Smckusick 	}
96122836Smckusick 
96222836Smckusick       frexpr((tagptr) p);
96322836Smckusick       frexpr((tagptr) q);
96422836Smckusick     }
96522836Smckusick   else
96622836Smckusick     if (optimflag)
96722836Smckusick       optbuff (SKEQ, mkexpr(OPASSIGN,q,p), 0,0);
96822836Smckusick     else
96922836Smckusick       puteq (q,p);
97022836Smckusick 
97122836Smckusick   return;
97222836Smckusick }
97322836Smckusick 
97422836Smckusick 
97522836Smckusick 
97622836Smckusick 
iosetc(offset,p)97722836Smckusick LOCAL iosetc(offset, p)
97822836Smckusick int offset;
97922836Smckusick register expptr p;
98022836Smckusick {
98122836Smckusick if(p == NULL)
98222836Smckusick 	ioset(TYADDR, offset, ICON(0) );
98322836Smckusick else if(p->headblock.vtype == TYCHAR)
98422836Smckusick 	ioset(TYADDR, offset, addrof(cpexpr(p) ));
98522836Smckusick else
98622836Smckusick 	err("non-character control clause");
98722836Smckusick }
98822836Smckusick 
98922836Smckusick 
99022836Smckusick 
ioseta(offset,p)99122836Smckusick LOCAL ioseta(offset, p)
99222836Smckusick int offset;
99322836Smckusick register Addrp p;
99422836Smckusick {
99522836Smckusick   static char *badoffset = "bad offset in ioseta";
99622836Smckusick 
99722836Smckusick   int blkno;
99822836Smckusick   register offsetlist *op;
99922836Smckusick 
100022836Smckusick   if(statstruct)
100122836Smckusick     {
100222836Smckusick       blkno = ioblkp->memno;
100322836Smckusick       op = mkiodata(blkno, offset, blklen);
100422836Smckusick       if (op->tag != 0)
100522836Smckusick 	fatal(badoffset);
100622836Smckusick 
100722836Smckusick       if (p == NULL)
100822836Smckusick 	op->tag = NDNULL;
100922836Smckusick       else if (p->tag == TADDR)
101022836Smckusick 	{
101122836Smckusick 	  op->tag = NDADDR;
101222836Smckusick 	  op->val.addr.stg = p->vstg;
101322836Smckusick 	  op->val.addr.memno = p->memno;
101433257Sbostic 	  op->val.addr.offset = p->memoffset->constblock.constant.ci;
101522836Smckusick 	}
101622836Smckusick       else
101722836Smckusick 	badtag("ioseta", p->tag);
101822836Smckusick     }
101922836Smckusick   else
102022836Smckusick     ioset(TYADDR, offset, p ? addrof(p) : ICON(0) );
102122836Smckusick 
102222836Smckusick   return;
102322836Smckusick }
102422836Smckusick 
102522836Smckusick 
102622836Smckusick 
102722836Smckusick 
iosetip(i,offset)102822836Smckusick LOCAL iosetip(i, offset)
102922836Smckusick int i, offset;
103022836Smckusick {
103122836Smckusick register expptr p;
103222836Smckusick 
103322836Smckusick if(p = V(i))
103422836Smckusick 	if(p->tag==TADDR &&
103522836Smckusick 	    ONEOF(p->addrblock.vtype, M(TYLONG)|M(TYLOGICAL)) )
103622836Smckusick 		ioset(TYADDR, offset, addrof(cpexpr(p)) );
103722836Smckusick 	else
103822836Smckusick 		errstr("impossible inquire parameter %s", ioc[i].iocname);
103922836Smckusick else
104022836Smckusick 	ioset(TYADDR, offset, ICON(0) );
104122836Smckusick }
104222836Smckusick 
104322836Smckusick 
104422836Smckusick 
iosetlc(i,offp,offl)104522836Smckusick LOCAL iosetlc(i, offp, offl)
104622836Smckusick int i, offp, offl;
104722836Smckusick {
104822836Smckusick register expptr p;
104922836Smckusick if( (p = V(i)) && p->headblock.vtype==TYCHAR)
105022836Smckusick 	ioset(TYIOINT, offl, cpexpr(p->headblock.vleng) );
105122836Smckusick iosetc(offp, p);
105222836Smckusick }
105322836Smckusick 
105422836Smckusick 
105522836Smckusick LOCAL offsetlist *
mkiodata(blkno,offset,len)105622836Smckusick mkiodata(blkno, offset, len)
105722836Smckusick int blkno;
105822836Smckusick ftnint offset;
105922836Smckusick ftnint len;
106022836Smckusick {
106122836Smckusick   register offsetlist *p, *q;
106222836Smckusick   register ioblock *t;
106322836Smckusick   register int found;
106422836Smckusick 
106522836Smckusick   found = NO;
106622836Smckusick   t = iodata;
106722836Smckusick 
106822836Smckusick   while (found == NO && t != NULL)
106922836Smckusick     {
107022836Smckusick       if (t->blkno == blkno)
107122836Smckusick 	found = YES;
107222836Smckusick       else
107322836Smckusick 	t = t->next;
107422836Smckusick     }
107522836Smckusick 
107622836Smckusick   if (found == NO)
107722836Smckusick     {
107822836Smckusick       t = ALLOC(IoBlock);
107922836Smckusick       t->blkno = blkno;
108022836Smckusick       t->next = iodata;
108122836Smckusick       iodata = t;
108222836Smckusick     }
108322836Smckusick 
108422836Smckusick   if (len > t->len)
108522836Smckusick     t->len = len;
108622836Smckusick 
108722836Smckusick   p = t->olist;
108822836Smckusick 
108922836Smckusick   if (p == NULL)
109022836Smckusick     {
109122836Smckusick       p = ALLOC(OffsetList);
109222836Smckusick       p->next = NULL;
109322836Smckusick       p->offset = offset;
109422836Smckusick       t->olist = p;
109522836Smckusick       return (p);
109622836Smckusick     }
109722836Smckusick 
109822836Smckusick   for (;;)
109922836Smckusick     {
110022836Smckusick       if (p->offset == offset)
110122836Smckusick 	return (p);
110222836Smckusick       else if (p->next != NULL &&
110322836Smckusick 	       p->next->offset <= offset)
110422836Smckusick 	p = p->next;
110522836Smckusick       else
110622836Smckusick 	{
110722836Smckusick 	  q = ALLOC(OffsetList);
110822836Smckusick 	  q->next = p->next;
110922836Smckusick 	  p->next = q;
111022836Smckusick 	  q->offset = offset;
111122836Smckusick 	  return (q);
111222836Smckusick 	}
111322836Smckusick     }
111422836Smckusick }
111522836Smckusick 
111622836Smckusick 
outiodata()111722836Smckusick outiodata()
111822836Smckusick {
111922836Smckusick   static char *varfmt = "v.%d:\n";
112022836Smckusick 
112122836Smckusick   register ioblock *p;
112222836Smckusick   register ioblock *t;
112322836Smckusick 
112422836Smckusick   if (iodata == NULL) return;
112522836Smckusick 
112622836Smckusick   p = iodata;
112722836Smckusick 
112822836Smckusick   while (p != NULL)
112922836Smckusick     {
113022836Smckusick       pralign(ALIDOUBLE);
113122836Smckusick       fprintf(initfile, varfmt, p->blkno);
113222836Smckusick       outolist(p->olist, p->len);
113322836Smckusick 
113422836Smckusick       t = p;
113522836Smckusick       p = t->next;
113622836Smckusick       free((char *) t);
113722836Smckusick     }
113822836Smckusick 
113922836Smckusick   iodata = NULL;
114022836Smckusick   return;
114122836Smckusick }
114222836Smckusick 
114322836Smckusick 
114422836Smckusick 
114522836Smckusick LOCAL
outolist(op,len)114622836Smckusick outolist(op, len)
114722836Smckusick register offsetlist *op;
114822836Smckusick register int len;
114922836Smckusick {
115022836Smckusick   static char *overlap = "overlapping i/o fields in outolist";
115122836Smckusick   static char *toolong = "offset too large in outolist";
115222836Smckusick 
115322836Smckusick   register offsetlist *t;
115422836Smckusick   register ftnint clen;
115522836Smckusick   register Constp cp;
115622836Smckusick   register int type;
115722836Smckusick 
115822836Smckusick   clen = 0;
115922836Smckusick 
116022836Smckusick   while (op != NULL)
116122836Smckusick     {
116222836Smckusick       if (clen > op->offset)
116322836Smckusick 	fatal(overlap);
116422836Smckusick 
116522836Smckusick       if (clen < op->offset)
116622836Smckusick 	{
116722836Smckusick 	  prspace(op->offset - clen);
116822836Smckusick 	  clen = op->offset;
116922836Smckusick 	}
117022836Smckusick 
117122836Smckusick       switch (op->tag)
117222836Smckusick 	{
117322836Smckusick 	default:
117422836Smckusick 	  badtag("outolist", op->tag);
117522836Smckusick 
117622836Smckusick 	case NDDATA:
117722836Smckusick 	  cp = op->val.cp;
117822836Smckusick 	  type = cp->vtype;
117922836Smckusick 	  if (type != TYIOINT)
118022836Smckusick 	    badtype("outolist", type);
118133257Sbostic 	  prconi(initfile, type, cp->constant.ci);
118222836Smckusick 	  clen += typesize[type];
118322836Smckusick 	  frexpr((tagptr) cp);
118422836Smckusick 	  break;
118522836Smckusick 
118622836Smckusick 	case NDLABEL:
118722836Smckusick 	  prcona(initfile, op->val.label);
118822836Smckusick 	  clen += typesize[TYADDR];
118922836Smckusick 	  break;
119022836Smckusick 
119122836Smckusick 	case NDADDR:
119222836Smckusick 	  praddr(initfile, op->val.addr.stg, op->val.addr.memno,
119322836Smckusick 		 op->val.addr.offset);
119422836Smckusick 	  clen += typesize[TYADDR];
119522836Smckusick 	  break;
119622836Smckusick 
119722836Smckusick 	case NDNULL:
119822836Smckusick 	  praddr(initfile, STGNULL, 0, (ftnint) 0);
119922836Smckusick 	  clen += typesize[TYADDR];
120022836Smckusick 	  break;
120122836Smckusick 	}
120222836Smckusick 
120322836Smckusick       t = op;
120422836Smckusick       op = t->next;
120522836Smckusick       free((char *) t);
120622836Smckusick     }
120722836Smckusick 
120822836Smckusick   if (clen > len)
120922836Smckusick     fatal(toolong);
121022836Smckusick 
121122836Smckusick   if (clen < len)
121222836Smckusick     prspace(len - clen);
121322836Smckusick 
121422836Smckusick   return;
121522836Smckusick }
1216