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