1*5be0f76fSbostic /*-
2*5be0f76fSbostic * Copyright (c) 1980 The Regents of the University of California.
3*5be0f76fSbostic * All rights reserved.
4*5be0f76fSbostic *
5*5be0f76fSbostic * %sccs.include.proprietary.c%
6621bd120Smckusick */
7621bd120Smckusick
8621bd120Smckusick #ifndef lint
9*5be0f76fSbostic static char sccsid[] = "@(#)io.c 5.5 (Berkeley) 04/12/91";
10*5be0f76fSbostic #endif /* not lint */
11621bd120Smckusick
12621bd120Smckusick /*
13621bd120Smckusick * io.c
14621bd120Smckusick *
15621bd120Smckusick * Routines to generate code for I/O statements.
16621bd120Smckusick * Some corrections and improvements due to David Wasley, U. C. Berkeley
17621bd120Smckusick *
18621bd120Smckusick * University of Utah CS Dept modification history:
19621bd120Smckusick *
208d7b78deSdonn * $Header: io.c,v 5.3 86/03/04 17:45:33 donn Exp $
21621bd120Smckusick * $Log: io.c,v $
228d7b78deSdonn * Revision 5.3 86/03/04 17:45:33 donn
238d7b78deSdonn * Change the order of length and offset code in startrw() -- always emit
248d7b78deSdonn * the memoffset first, since it may define a temporary which is used in
258d7b78deSdonn * the length expression.
268d7b78deSdonn *
27a99ab251Sdonn * Revision 5.2 85/12/19 17:22:35 donn
28a99ab251Sdonn * Don't permit more than one 'positional iocontrol' parameter unless we
29a99ab251Sdonn * are doing a READ or a WRITE.
30a99ab251Sdonn *
31a99ab251Sdonn * Revision 5.1 85/08/10 03:47:42 donn
32a99ab251Sdonn * 4.3 alpha
33a99ab251Sdonn *
34621bd120Smckusick * Revision 2.4 85/02/23 21:09:02 donn
35621bd120Smckusick * Jerry Berkman's compiled format fixes move setfmt into a separate file.
36621bd120Smckusick *
37621bd120Smckusick * Revision 2.3 85/01/10 22:33:41 donn
38621bd120Smckusick * Added some strategic cpexpr()s to prevent memory management bugs.
39621bd120Smckusick *
40621bd120Smckusick * Revision 2.2 84/08/04 21:15:47 donn
41621bd120Smckusick * Removed code that creates extra statement labels, per Jerry Berkman's
42621bd120Smckusick * fixes to make ASSIGNs work right.
43621bd120Smckusick *
44621bd120Smckusick * Revision 2.1 84/07/19 12:03:33 donn
45621bd120Smckusick * Changed comment headers for UofU.
46621bd120Smckusick *
47621bd120Smckusick * Revision 1.2 84/02/26 06:35:57 donn
48621bd120Smckusick * Added Berkeley changes necessary for shortening offsets to data.
49621bd120Smckusick *
50621bd120Smckusick */
51621bd120Smckusick
52621bd120Smckusick /* TEMPORARY */
53621bd120Smckusick #define TYIOINT TYLONG
54621bd120Smckusick #define SZIOINT SZLONG
55621bd120Smckusick
56621bd120Smckusick #include "defs.h"
57621bd120Smckusick #include "io.h"
58621bd120Smckusick
59621bd120Smckusick
60621bd120Smckusick LOCAL char ioroutine[XL+1];
61621bd120Smckusick
62621bd120Smckusick LOCAL int ioendlab;
63621bd120Smckusick LOCAL int ioerrlab;
64621bd120Smckusick LOCAL int endbit;
65621bd120Smckusick LOCAL int errbit;
66621bd120Smckusick LOCAL int jumplab;
67621bd120Smckusick LOCAL int skiplab;
68621bd120Smckusick LOCAL int ioformatted;
69621bd120Smckusick LOCAL int statstruct = NO;
70621bd120Smckusick LOCAL ftnint blklen;
71621bd120Smckusick
72621bd120Smckusick LOCAL offsetlist *mkiodata();
73621bd120Smckusick
74621bd120Smckusick
75621bd120Smckusick #define UNFORMATTED 0
76621bd120Smckusick #define FORMATTED 1
77621bd120Smckusick #define LISTDIRECTED 2
78621bd120Smckusick #define NAMEDIRECTED 3
79621bd120Smckusick
80621bd120Smckusick #define V(z) ioc[z].iocval
81621bd120Smckusick
82621bd120Smckusick #define IOALL 07777
83621bd120Smckusick
84621bd120Smckusick LOCAL struct Ioclist
85621bd120Smckusick {
86621bd120Smckusick char *iocname;
87621bd120Smckusick int iotype;
88621bd120Smckusick expptr iocval;
89621bd120Smckusick } ioc[ ] =
90621bd120Smckusick {
91621bd120Smckusick { "", 0 },
92621bd120Smckusick { "unit", IOALL },
93621bd120Smckusick { "fmt", M(IOREAD) | M(IOWRITE) },
94621bd120Smckusick { "err", IOALL },
95621bd120Smckusick { "end", M(IOREAD) },
96621bd120Smckusick { "iostat", IOALL },
97621bd120Smckusick { "rec", M(IOREAD) | M(IOWRITE) },
98621bd120Smckusick { "recl", M(IOOPEN) | M(IOINQUIRE) },
99621bd120Smckusick { "file", M(IOOPEN) | M(IOINQUIRE) },
100621bd120Smckusick { "status", M(IOOPEN) | M(IOCLOSE) },
101621bd120Smckusick { "access", M(IOOPEN) | M(IOINQUIRE) },
102621bd120Smckusick { "form", M(IOOPEN) | M(IOINQUIRE) },
103621bd120Smckusick { "blank", M(IOOPEN) | M(IOINQUIRE) },
104621bd120Smckusick { "exist", M(IOINQUIRE) },
105621bd120Smckusick { "opened", M(IOINQUIRE) },
106621bd120Smckusick { "number", M(IOINQUIRE) },
107621bd120Smckusick { "named", M(IOINQUIRE) },
108621bd120Smckusick { "name", M(IOINQUIRE) },
109621bd120Smckusick { "sequential", M(IOINQUIRE) },
110621bd120Smckusick { "direct", M(IOINQUIRE) },
111621bd120Smckusick { "formatted", M(IOINQUIRE) },
112621bd120Smckusick { "unformatted", M(IOINQUIRE) },
113621bd120Smckusick { "nextrec", M(IOINQUIRE) }
114621bd120Smckusick } ;
115621bd120Smckusick
116621bd120Smckusick #define NIOS (sizeof(ioc)/sizeof(struct Ioclist) - 1)
117621bd120Smckusick #define MAXIO SZFLAG + 10*SZIOINT + 15*SZADDR
118621bd120Smckusick
119621bd120Smckusick #define IOSUNIT 1
120621bd120Smckusick #define IOSFMT 2
121621bd120Smckusick #define IOSERR 3
122621bd120Smckusick #define IOSEND 4
123621bd120Smckusick #define IOSIOSTAT 5
124621bd120Smckusick #define IOSREC 6
125621bd120Smckusick #define IOSRECL 7
126621bd120Smckusick #define IOSFILE 8
127621bd120Smckusick #define IOSSTATUS 9
128621bd120Smckusick #define IOSACCESS 10
129621bd120Smckusick #define IOSFORM 11
130621bd120Smckusick #define IOSBLANK 12
131621bd120Smckusick #define IOSEXISTS 13
132621bd120Smckusick #define IOSOPENED 14
133621bd120Smckusick #define IOSNUMBER 15
134621bd120Smckusick #define IOSNAMED 16
135621bd120Smckusick #define IOSNAME 17
136621bd120Smckusick #define IOSSEQUENTIAL 18
137621bd120Smckusick #define IOSDIRECT 19
138621bd120Smckusick #define IOSFORMATTED 20
139621bd120Smckusick #define IOSUNFORMATTED 21
140621bd120Smckusick #define IOSNEXTREC 22
141621bd120Smckusick
142621bd120Smckusick #define IOSTP V(IOSIOSTAT)
143621bd120Smckusick
144621bd120Smckusick
145621bd120Smckusick /* offsets in generated structures */
146621bd120Smckusick
147621bd120Smckusick #define SZFLAG SZIOINT
148621bd120Smckusick
149621bd120Smckusick /* offsets for external READ and WRITE statements */
150621bd120Smckusick
151621bd120Smckusick #define XERR 0
152621bd120Smckusick #define XUNIT SZFLAG
153621bd120Smckusick #define XEND SZFLAG + SZIOINT
154621bd120Smckusick #define XFMT 2*SZFLAG + SZIOINT
155621bd120Smckusick #define XREC 2*SZFLAG + SZIOINT + SZADDR
156621bd120Smckusick #define XRLEN 2*SZFLAG + 2*SZADDR
157621bd120Smckusick #define XRNUM 2*SZFLAG + 2*SZADDR + SZIOINT
158621bd120Smckusick
159621bd120Smckusick /* offsets for internal READ and WRITE statements */
160621bd120Smckusick
161621bd120Smckusick #define XIERR 0
162621bd120Smckusick #define XIUNIT SZFLAG
163621bd120Smckusick #define XIEND SZFLAG + SZADDR
164621bd120Smckusick #define XIFMT 2*SZFLAG + SZADDR
165621bd120Smckusick #define XIRLEN 2*SZFLAG + 2*SZADDR
166621bd120Smckusick #define XIRNUM 2*SZFLAG + 2*SZADDR + SZIOINT
167621bd120Smckusick #define XIREC 2*SZFLAG + 2*SZADDR + 2*SZIOINT
168621bd120Smckusick
169621bd120Smckusick /* offsets for OPEN statements */
170621bd120Smckusick
171621bd120Smckusick #define XFNAME SZFLAG + SZIOINT
172621bd120Smckusick #define XFNAMELEN SZFLAG + SZIOINT + SZADDR
173621bd120Smckusick #define XSTATUS SZFLAG + 2*SZIOINT + SZADDR
174621bd120Smckusick #define XACCESS SZFLAG + 2*SZIOINT + 2*SZADDR
175621bd120Smckusick #define XFORMATTED SZFLAG + 2*SZIOINT + 3*SZADDR
176621bd120Smckusick #define XRECLEN SZFLAG + 2*SZIOINT + 4*SZADDR
177621bd120Smckusick #define XBLANK SZFLAG + 3*SZIOINT + 4*SZADDR
178621bd120Smckusick
179621bd120Smckusick /* offset for CLOSE statement */
180621bd120Smckusick
181621bd120Smckusick #define XCLSTATUS SZFLAG + SZIOINT
182621bd120Smckusick
183621bd120Smckusick /* offsets for INQUIRE statement */
184621bd120Smckusick
185621bd120Smckusick #define XFILE SZFLAG + SZIOINT
186621bd120Smckusick #define XFILELEN SZFLAG + SZIOINT + SZADDR
187621bd120Smckusick #define XEXISTS SZFLAG + 2*SZIOINT + SZADDR
188621bd120Smckusick #define XOPEN SZFLAG + 2*SZIOINT + 2*SZADDR
189621bd120Smckusick #define XNUMBER SZFLAG + 2*SZIOINT + 3*SZADDR
190621bd120Smckusick #define XNAMED SZFLAG + 2*SZIOINT + 4*SZADDR
191621bd120Smckusick #define XNAME SZFLAG + 2*SZIOINT + 5*SZADDR
192621bd120Smckusick #define XNAMELEN SZFLAG + 2*SZIOINT + 6*SZADDR
193621bd120Smckusick #define XQACCESS SZFLAG + 3*SZIOINT + 6*SZADDR
194621bd120Smckusick #define XQACCLEN SZFLAG + 3*SZIOINT + 7*SZADDR
195621bd120Smckusick #define XSEQ SZFLAG + 4*SZIOINT + 7*SZADDR
196621bd120Smckusick #define XSEQLEN SZFLAG + 4*SZIOINT + 8*SZADDR
197621bd120Smckusick #define XDIRECT SZFLAG + 5*SZIOINT + 8*SZADDR
198621bd120Smckusick #define XDIRLEN SZFLAG + 5*SZIOINT + 9*SZADDR
199621bd120Smckusick #define XFORM SZFLAG + 6*SZIOINT + 9*SZADDR
200621bd120Smckusick #define XFORMLEN SZFLAG + 6*SZIOINT + 10*SZADDR
201621bd120Smckusick #define XFMTED SZFLAG + 7*SZIOINT + 10*SZADDR
202621bd120Smckusick #define XFMTEDLEN SZFLAG + 7*SZIOINT + 11*SZADDR
203621bd120Smckusick #define XUNFMT SZFLAG + 8*SZIOINT + 11*SZADDR
204621bd120Smckusick #define XUNFMTLEN SZFLAG + 8*SZIOINT + 12*SZADDR
205621bd120Smckusick #define XQRECL SZFLAG + 9*SZIOINT + 12*SZADDR
206621bd120Smckusick #define XNEXTREC SZFLAG + 9*SZIOINT + 13*SZADDR
207621bd120Smckusick #define XQBLANK SZFLAG + 9*SZIOINT + 14*SZADDR
208621bd120Smckusick #define XQBLANKLEN SZFLAG + 9*SZIOINT + 15*SZADDR
209621bd120Smckusick
fmtstmt(lp)210621bd120Smckusick fmtstmt(lp)
211621bd120Smckusick register struct Labelblock *lp;
212621bd120Smckusick {
213621bd120Smckusick if(lp == NULL)
214621bd120Smckusick {
215621bd120Smckusick execerr("unlabeled format statement" , CNULL);
216621bd120Smckusick return(-1);
217621bd120Smckusick }
218621bd120Smckusick if(lp->labtype == LABUNKNOWN)
219621bd120Smckusick lp->labtype = LABFORMAT;
220621bd120Smckusick else if(lp->labtype != LABFORMAT)
221621bd120Smckusick {
222621bd120Smckusick execerr("bad format number", CNULL);
223621bd120Smckusick return(-1);
224621bd120Smckusick }
225621bd120Smckusick return(lp->labelno);
226621bd120Smckusick }
227621bd120Smckusick
228621bd120Smckusick
229621bd120Smckusick
startioctl()230621bd120Smckusick startioctl()
231621bd120Smckusick {
232621bd120Smckusick register int i;
233621bd120Smckusick
234621bd120Smckusick inioctl = YES;
235621bd120Smckusick nioctl = 0;
236621bd120Smckusick ioformatted = UNFORMATTED;
237621bd120Smckusick for(i = 1 ; i<=NIOS ; ++i)
238621bd120Smckusick V(i) = NULL;
239621bd120Smckusick }
240621bd120Smckusick
241621bd120Smckusick
242621bd120Smckusick
endioctl()243621bd120Smckusick endioctl()
244621bd120Smckusick {
245621bd120Smckusick int i;
246621bd120Smckusick expptr p;
247621bd120Smckusick
248621bd120Smckusick inioctl = NO;
249621bd120Smckusick
250621bd120Smckusick /* set up for error recovery */
251621bd120Smckusick
252621bd120Smckusick ioerrlab = ioendlab = skiplab = jumplab = 0;
253621bd120Smckusick
254621bd120Smckusick if(p = V(IOSEND))
255621bd120Smckusick if(ISICON(p))
2569e02124eSbostic ioendlab = execlab(p->constblock.constant.ci) ->labelno;
257621bd120Smckusick else
258621bd120Smckusick err("bad end= clause");
259621bd120Smckusick
260621bd120Smckusick if(p = V(IOSERR))
261621bd120Smckusick if(ISICON(p))
2629e02124eSbostic ioerrlab = execlab(p->constblock.constant.ci) ->labelno;
263621bd120Smckusick else
264621bd120Smckusick err("bad err= clause");
265621bd120Smckusick
266621bd120Smckusick if(IOSTP)
267621bd120Smckusick if(IOSTP->tag!=TADDR || ! ISINT(IOSTP->addrblock.vtype) )
268621bd120Smckusick {
269621bd120Smckusick err("iostat must be an integer variable");
270621bd120Smckusick frexpr(IOSTP);
271621bd120Smckusick IOSTP = NULL;
272621bd120Smckusick }
273621bd120Smckusick
274621bd120Smckusick if(iostmt == IOREAD)
275621bd120Smckusick {
276621bd120Smckusick if(IOSTP)
277621bd120Smckusick {
278621bd120Smckusick if(ioerrlab && ioendlab && ioerrlab==ioendlab)
279621bd120Smckusick jumplab = ioerrlab;
280621bd120Smckusick else
281621bd120Smckusick skiplab = jumplab = newlabel();
282621bd120Smckusick }
283621bd120Smckusick else {
284621bd120Smckusick if(ioerrlab && ioendlab && ioerrlab!=ioendlab)
285621bd120Smckusick {
286621bd120Smckusick IOSTP = (expptr) mktemp(TYINT, PNULL);
287621bd120Smckusick skiplab = jumplab = newlabel();
288621bd120Smckusick }
289621bd120Smckusick else
290621bd120Smckusick jumplab = (ioerrlab ? ioerrlab : ioendlab);
291621bd120Smckusick }
292621bd120Smckusick }
293621bd120Smckusick else if(iostmt == IOWRITE)
294621bd120Smckusick {
295621bd120Smckusick if(IOSTP && !ioerrlab)
296621bd120Smckusick skiplab = jumplab = newlabel();
297621bd120Smckusick else
298621bd120Smckusick jumplab = ioerrlab;
299621bd120Smckusick }
300621bd120Smckusick else
301621bd120Smckusick jumplab = ioerrlab;
302621bd120Smckusick
303621bd120Smckusick endbit = IOSTP!=NULL || ioendlab!=0; /* for use in startrw() */
304621bd120Smckusick errbit = IOSTP!=NULL || ioerrlab!=0;
305621bd120Smckusick if(iostmt!=IOREAD && iostmt!=IOWRITE)
306621bd120Smckusick {
307621bd120Smckusick if(ioblkp == NULL)
308621bd120Smckusick ioblkp = autovar( (MAXIO+SZIOINT-1)/SZIOINT , TYIOINT, PNULL);
309621bd120Smckusick ioset(TYIOINT, XERR, ICON(errbit));
310621bd120Smckusick }
311621bd120Smckusick
312621bd120Smckusick switch(iostmt)
313621bd120Smckusick {
314621bd120Smckusick case IOOPEN:
315621bd120Smckusick dofopen(); break;
316621bd120Smckusick
317621bd120Smckusick case IOCLOSE:
318621bd120Smckusick dofclose(); break;
319621bd120Smckusick
320621bd120Smckusick case IOINQUIRE:
321621bd120Smckusick dofinquire(); break;
322621bd120Smckusick
323621bd120Smckusick case IOBACKSPACE:
324621bd120Smckusick dofmove("f_back"); break;
325621bd120Smckusick
326621bd120Smckusick case IOREWIND:
327621bd120Smckusick dofmove("f_rew"); break;
328621bd120Smckusick
329621bd120Smckusick case IOENDFILE:
330621bd120Smckusick dofmove("f_end"); break;
331621bd120Smckusick
332621bd120Smckusick case IOREAD:
333621bd120Smckusick case IOWRITE:
334621bd120Smckusick startrw(); break;
335621bd120Smckusick
336621bd120Smckusick default:
337621bd120Smckusick fatali("impossible iostmt %d", iostmt);
338621bd120Smckusick }
339621bd120Smckusick for(i = 1 ; i<=NIOS ; ++i)
340621bd120Smckusick if(i!=IOSIOSTAT && V(i)!=NULL)
341621bd120Smckusick frexpr(V(i));
342621bd120Smckusick }
343621bd120Smckusick
344621bd120Smckusick
345621bd120Smckusick
iocname()346621bd120Smckusick iocname()
347621bd120Smckusick {
348621bd120Smckusick register int i;
349621bd120Smckusick int found, mask;
350621bd120Smckusick
351621bd120Smckusick found = 0;
352621bd120Smckusick mask = M(iostmt);
353621bd120Smckusick for(i = 1 ; i <= NIOS ; ++i)
354621bd120Smckusick if(toklen==strlen(ioc[i].iocname) && eqn(toklen, token, ioc[i].iocname))
355621bd120Smckusick if(ioc[i].iotype & mask)
356621bd120Smckusick return(i);
357621bd120Smckusick else found = i;
358621bd120Smckusick if(found)
359621bd120Smckusick errstr("invalid control %s for statement", ioc[found].iocname);
360621bd120Smckusick else
361621bd120Smckusick errstr("unknown iocontrol %s", varstr(toklen, token) );
362621bd120Smckusick return(IOSBAD);
363621bd120Smckusick }
364621bd120Smckusick
365621bd120Smckusick
ioclause(n,p)366621bd120Smckusick ioclause(n, p)
367621bd120Smckusick register int n;
368621bd120Smckusick register expptr p;
369621bd120Smckusick {
370621bd120Smckusick struct Ioclist *iocp;
371621bd120Smckusick
372621bd120Smckusick ++nioctl;
373621bd120Smckusick if(n == IOSBAD)
374621bd120Smckusick return;
375621bd120Smckusick if(n == IOSPOSITIONAL)
376621bd120Smckusick {
377a99ab251Sdonn if(nioctl > IOSFMT ||
378a99ab251Sdonn nioctl > IOSUNIT && !(iostmt == IOREAD || iostmt == IOWRITE))
379621bd120Smckusick {
380621bd120Smckusick err("illegal positional iocontrol");
381621bd120Smckusick return;
382621bd120Smckusick }
383621bd120Smckusick n = nioctl;
384621bd120Smckusick }
385621bd120Smckusick
386621bd120Smckusick if(p == NULL)
387621bd120Smckusick {
388621bd120Smckusick if(n == IOSUNIT)
389621bd120Smckusick p = (expptr) (iostmt==IOREAD ? IOSTDIN : IOSTDOUT);
390621bd120Smckusick else if(n != IOSFMT)
391621bd120Smckusick {
392621bd120Smckusick err("illegal * iocontrol");
393621bd120Smckusick return;
394621bd120Smckusick }
395621bd120Smckusick }
396621bd120Smckusick if(n == IOSFMT)
397621bd120Smckusick ioformatted = (p==NULL ? LISTDIRECTED : FORMATTED);
398621bd120Smckusick
399621bd120Smckusick iocp = & ioc[n];
400621bd120Smckusick if(iocp->iocval == NULL)
401621bd120Smckusick {
402621bd120Smckusick p = (expptr) cpexpr(p);
403621bd120Smckusick if(n!=IOSFMT && ( n!=IOSUNIT || (p!=NULL && p->headblock.vtype!=TYCHAR) ) )
404621bd120Smckusick p = fixtype(p);
405621bd120Smckusick if(p!=NULL && ISCONST(p) && p->constblock.vtype==TYCHAR)
406621bd120Smckusick p = (expptr) putconst(p);
407621bd120Smckusick iocp->iocval = p;
408621bd120Smckusick }
409621bd120Smckusick else
410621bd120Smckusick errstr("iocontrol %s repeated", iocp->iocname);
411621bd120Smckusick }
412621bd120Smckusick
413621bd120Smckusick /* io list item */
414621bd120Smckusick
doio(list)415621bd120Smckusick doio(list)
416621bd120Smckusick chainp list;
417621bd120Smckusick {
418621bd120Smckusick expptr call0();
419621bd120Smckusick
420621bd120Smckusick if(ioformatted == NAMEDIRECTED)
421621bd120Smckusick {
422621bd120Smckusick if(list)
423621bd120Smckusick err("no I/O list allowed in NAMELIST read/write");
424621bd120Smckusick }
425621bd120Smckusick else
426621bd120Smckusick {
427621bd120Smckusick doiolist(list);
428621bd120Smckusick ioroutine[0] = 'e';
429621bd120Smckusick putiocall( call0(TYINT, ioroutine) );
430621bd120Smckusick }
431621bd120Smckusick }
432621bd120Smckusick
433621bd120Smckusick
434621bd120Smckusick
435621bd120Smckusick
436621bd120Smckusick
doiolist(p0)437621bd120Smckusick LOCAL doiolist(p0)
438621bd120Smckusick chainp p0;
439621bd120Smckusick {
440621bd120Smckusick chainp p;
441621bd120Smckusick register tagptr q;
442621bd120Smckusick register expptr qe;
443621bd120Smckusick register Namep qn;
444621bd120Smckusick Addrp tp, mkscalar();
445621bd120Smckusick int range;
446621bd120Smckusick expptr expr;
447621bd120Smckusick
448621bd120Smckusick for (p = p0 ; p ; p = p->nextp)
449621bd120Smckusick {
450621bd120Smckusick q = p->datap;
451621bd120Smckusick if(q->tag == TIMPLDO)
452621bd120Smckusick {
453621bd120Smckusick exdo(range=newlabel(), q->impldoblock.impdospec);
454621bd120Smckusick doiolist(q->impldoblock.datalist);
455621bd120Smckusick enddo(range);
456621bd120Smckusick free( (charptr) q);
457621bd120Smckusick }
458621bd120Smckusick else {
459621bd120Smckusick if(q->tag==TPRIM && q->primblock.argsp==NULL
460621bd120Smckusick && q->primblock.namep->vdim!=NULL)
461621bd120Smckusick {
462621bd120Smckusick vardcl(qn = q->primblock.namep);
463621bd120Smckusick if(qn->vdim->nelt)
464621bd120Smckusick putio( fixtype(cpexpr(qn->vdim->nelt)),
465621bd120Smckusick mkscalar(qn) );
466621bd120Smckusick else
467621bd120Smckusick err("attempt to i/o array of unknown size");
468621bd120Smckusick }
469621bd120Smckusick else if(q->tag==TPRIM && q->primblock.argsp==NULL &&
470621bd120Smckusick (qe = (expptr) memversion(q->primblock.namep)) )
471621bd120Smckusick putio(ICON(1),qe);
472621bd120Smckusick else if( (qe = fixtype(cpexpr(q)))->tag==TADDR)
473621bd120Smckusick putio(ICON(1), qe);
474621bd120Smckusick else if(qe->headblock.vtype != TYERROR)
475621bd120Smckusick {
476621bd120Smckusick if(iostmt == IOWRITE)
477621bd120Smckusick {
478621bd120Smckusick ftnint lencat();
479621bd120Smckusick expptr qvl;
480621bd120Smckusick qvl = NULL;
481621bd120Smckusick if( ISCHAR(qe) )
482621bd120Smckusick {
483621bd120Smckusick qvl = (expptr)
484621bd120Smckusick cpexpr(qe->headblock.vleng);
485621bd120Smckusick tp = mktemp(qe->headblock.vtype,
486621bd120Smckusick ICON(lencat(qe)));
487621bd120Smckusick }
488621bd120Smckusick else
489621bd120Smckusick tp = mktemp(qe->headblock.vtype,
490621bd120Smckusick qe->headblock.vleng);
491621bd120Smckusick if (optimflag)
492621bd120Smckusick {
493621bd120Smckusick expr = mkexpr(OPASSIGN,cpexpr(tp),qe);
494621bd120Smckusick optbuff (SKEQ,expr,0,0);
495621bd120Smckusick }
496621bd120Smckusick else
497621bd120Smckusick puteq (cpexpr(tp),qe);
498621bd120Smckusick if(qvl) /* put right length on block */
499621bd120Smckusick {
500621bd120Smckusick frexpr(tp->vleng);
501621bd120Smckusick tp->vleng = qvl;
502621bd120Smckusick }
503621bd120Smckusick putio(ICON(1), tp);
504621bd120Smckusick }
505621bd120Smckusick else
506621bd120Smckusick err("non-left side in READ list");
507621bd120Smckusick }
508621bd120Smckusick frexpr(q);
509621bd120Smckusick }
510621bd120Smckusick }
511621bd120Smckusick frchain( &p0 );
512621bd120Smckusick }
513621bd120Smckusick
514621bd120Smckusick
515621bd120Smckusick
516621bd120Smckusick
517621bd120Smckusick
putio(nelt,addr)518621bd120Smckusick LOCAL putio(nelt, addr)
519621bd120Smckusick expptr nelt;
520621bd120Smckusick register expptr addr;
521621bd120Smckusick {
522621bd120Smckusick int type;
523621bd120Smckusick register expptr q;
524621bd120Smckusick
525621bd120Smckusick type = addr->headblock.vtype;
526621bd120Smckusick if(ioformatted!=LISTDIRECTED && ISCOMPLEX(type) )
527621bd120Smckusick {
528621bd120Smckusick nelt = mkexpr(OPSTAR, ICON(2), nelt);
529621bd120Smckusick type -= (TYCOMPLEX-TYREAL);
530621bd120Smckusick }
531621bd120Smckusick
532621bd120Smckusick /* pass a length with every item. for noncharacter data, fake one */
533621bd120Smckusick if(type != TYCHAR)
534621bd120Smckusick {
535621bd120Smckusick addr->headblock.vtype = TYCHAR;
536621bd120Smckusick addr->headblock.vleng = ICON( typesize[type] );
537621bd120Smckusick }
538621bd120Smckusick
539621bd120Smckusick nelt = fixtype( mkconv(TYLENG,nelt) );
540621bd120Smckusick if(ioformatted == LISTDIRECTED)
541621bd120Smckusick q = call3(TYINT, "do_lio", mkconv(TYLONG, ICON(type)), nelt, addr);
542621bd120Smckusick else
543621bd120Smckusick q = call2(TYINT, (ioformatted==FORMATTED ? "do_fio" : "do_uio"),
544621bd120Smckusick nelt, addr);
545621bd120Smckusick putiocall(q);
546621bd120Smckusick }
547621bd120Smckusick
548621bd120Smckusick
549621bd120Smckusick
550621bd120Smckusick
endio()551621bd120Smckusick endio()
552621bd120Smckusick {
553621bd120Smckusick if(skiplab)
554621bd120Smckusick {
555621bd120Smckusick if (optimflag)
556621bd120Smckusick optbuff (SKLABEL, 0, skiplab, 0);
557621bd120Smckusick else
558621bd120Smckusick putlabel (skiplab);
559621bd120Smckusick if(ioendlab)
560621bd120Smckusick {
561621bd120Smckusick expptr test;
562621bd120Smckusick test = mkexpr(OPGE, cpexpr(IOSTP), ICON(0));
563621bd120Smckusick if (optimflag)
564621bd120Smckusick optbuff (SKIOIFN,test,ioendlab,0);
565621bd120Smckusick else
566621bd120Smckusick putif (test,ioendlab);
567621bd120Smckusick }
568621bd120Smckusick if(ioerrlab)
569621bd120Smckusick {
570621bd120Smckusick expptr test;
571621bd120Smckusick test = mkexpr
572621bd120Smckusick ( ((iostmt==IOREAD||iostmt==IOWRITE) ? OPLE : OPEQ),
573621bd120Smckusick cpexpr(IOSTP), ICON(0));
574621bd120Smckusick if (optimflag)
575621bd120Smckusick optbuff (SKIOIFN,test,ioerrlab,0);
576621bd120Smckusick else
577621bd120Smckusick putif (test,ioerrlab);
578621bd120Smckusick }
579621bd120Smckusick }
580621bd120Smckusick if(IOSTP)
581621bd120Smckusick frexpr(IOSTP);
582621bd120Smckusick }
583621bd120Smckusick
584621bd120Smckusick
585621bd120Smckusick
putiocall(q)586621bd120Smckusick LOCAL putiocall(q)
587621bd120Smckusick register expptr q;
588621bd120Smckusick {
589621bd120Smckusick if(IOSTP)
590621bd120Smckusick {
591621bd120Smckusick q->headblock.vtype = TYINT;
592621bd120Smckusick q = fixexpr( mkexpr(OPASSIGN, cpexpr(IOSTP), q));
593621bd120Smckusick }
594621bd120Smckusick
595621bd120Smckusick if(jumplab)
596621bd120Smckusick if (optimflag)
597621bd120Smckusick optbuff (SKIOIFN,mkexpr(OPEQ,q,ICON(0)),jumplab,0);
598621bd120Smckusick else
599621bd120Smckusick putif (mkexpr(OPEQ,q,ICON(0)),jumplab);
600621bd120Smckusick else
601621bd120Smckusick if (optimflag)
602621bd120Smckusick optbuff (SKEQ, q, 0, 0);
603621bd120Smckusick else
604621bd120Smckusick putexpr(q);
605621bd120Smckusick }
606621bd120Smckusick
startrw()607621bd120Smckusick startrw()
608621bd120Smckusick {
609621bd120Smckusick register expptr p;
610621bd120Smckusick register Namep np;
611621bd120Smckusick register Addrp unitp, fmtp, recp, tioblkp;
612621bd120Smckusick register expptr nump;
613621bd120Smckusick register ioblock *t;
614621bd120Smckusick Addrp mkscalar();
615621bd120Smckusick expptr mkaddcon();
616621bd120Smckusick int k;
617621bd120Smckusick flag intfile, sequential, ok, varfmt;
618621bd120Smckusick
619621bd120Smckusick /* First look at all the parameters and determine what is to be done */
620621bd120Smckusick
621621bd120Smckusick ok = YES;
622621bd120Smckusick statstruct = YES;
623621bd120Smckusick
624621bd120Smckusick intfile = NO;
625621bd120Smckusick if(p = V(IOSUNIT))
626621bd120Smckusick {
627621bd120Smckusick if( ISINT(p->headblock.vtype) )
628621bd120Smckusick unitp = (Addrp) cpexpr(p);
629621bd120Smckusick else if(p->headblock.vtype == TYCHAR)
630621bd120Smckusick {
631621bd120Smckusick intfile = YES;
632621bd120Smckusick if(p->tag==TPRIM && p->primblock.argsp==NULL &&
633621bd120Smckusick (np = p->primblock.namep)->vdim!=NULL)
634621bd120Smckusick {
635621bd120Smckusick vardcl(np);
636621bd120Smckusick if(np->vdim->nelt)
637621bd120Smckusick {
638621bd120Smckusick nump = (expptr) cpexpr(np->vdim->nelt);
639621bd120Smckusick if( ! ISCONST(nump) )
640621bd120Smckusick statstruct = NO;
641621bd120Smckusick }
642621bd120Smckusick else
643621bd120Smckusick {
644621bd120Smckusick err("attempt to use internal unit array of unknown size");
645621bd120Smckusick ok = NO;
646621bd120Smckusick nump = ICON(1);
647621bd120Smckusick }
648621bd120Smckusick unitp = mkscalar(np);
649621bd120Smckusick }
650621bd120Smckusick else {
651621bd120Smckusick nump = ICON(1);
652621bd120Smckusick unitp = (Addrp) fixtype(cpexpr(p));
653621bd120Smckusick }
654621bd120Smckusick if(! isstatic(unitp) )
655621bd120Smckusick statstruct = NO;
656621bd120Smckusick }
657621bd120Smckusick else
658621bd120Smckusick {
659621bd120Smckusick err("bad unit specifier type");
660621bd120Smckusick ok = NO;
661621bd120Smckusick }
662621bd120Smckusick }
663621bd120Smckusick else
664621bd120Smckusick {
665621bd120Smckusick err("bad unit specifier");
666621bd120Smckusick ok = NO;
667621bd120Smckusick }
668621bd120Smckusick
669621bd120Smckusick sequential = YES;
670621bd120Smckusick if(p = V(IOSREC))
671621bd120Smckusick if( ISINT(p->headblock.vtype) )
672621bd120Smckusick {
673621bd120Smckusick recp = (Addrp) cpexpr(p);
674621bd120Smckusick sequential = NO;
675621bd120Smckusick }
676621bd120Smckusick else {
677621bd120Smckusick err("bad REC= clause");
678621bd120Smckusick ok = NO;
679621bd120Smckusick }
680621bd120Smckusick else
681621bd120Smckusick recp = NULL;
682621bd120Smckusick
683621bd120Smckusick
684621bd120Smckusick varfmt = YES;
685621bd120Smckusick fmtp = NULL;
686621bd120Smckusick if(p = V(IOSFMT))
687621bd120Smckusick {
688621bd120Smckusick if(p->tag==TPRIM && p->primblock.argsp==NULL)
689621bd120Smckusick {
690621bd120Smckusick np = p->primblock.namep;
691621bd120Smckusick if(np->vclass == CLNAMELIST)
692621bd120Smckusick {
693621bd120Smckusick ioformatted = NAMEDIRECTED;
694621bd120Smckusick fmtp = (Addrp) fixtype(cpexpr(p));
695621bd120Smckusick goto endfmt;
696621bd120Smckusick }
697621bd120Smckusick vardcl(np);
698621bd120Smckusick if(np->vdim)
699621bd120Smckusick {
700621bd120Smckusick if( ! ONEOF(np->vstg, MSKSTATIC) )
701621bd120Smckusick statstruct = NO;
702621bd120Smckusick fmtp = mkscalar(np);
703621bd120Smckusick goto endfmt;
704621bd120Smckusick }
705621bd120Smckusick if( ISINT(np->vtype) ) /* ASSIGNed label */
706621bd120Smckusick {
707621bd120Smckusick statstruct = NO;
708621bd120Smckusick varfmt = NO;
709621bd120Smckusick fmtp = (Addrp) fixtype(cpexpr(p));
710621bd120Smckusick goto endfmt;
711621bd120Smckusick }
712621bd120Smckusick }
713621bd120Smckusick p = V(IOSFMT) = fixtype(p);
714621bd120Smckusick if(p->headblock.vtype == TYCHAR)
715621bd120Smckusick {
716621bd120Smckusick if (p->tag == TCONST) p = (expptr) putconst(p);
717621bd120Smckusick if( ! isstatic(p) )
718621bd120Smckusick statstruct = NO;
719621bd120Smckusick fmtp = (Addrp) cpexpr(p);
720621bd120Smckusick }
721621bd120Smckusick else if( ISICON(p) )
722621bd120Smckusick {
7239e02124eSbostic if( (k = fmtstmt( mklabel(p->constblock.constant.ci) )) > 0 )
724621bd120Smckusick {
725621bd120Smckusick fmtp = (Addrp) mkaddcon(k);
726621bd120Smckusick varfmt = NO;
727621bd120Smckusick }
728621bd120Smckusick else
729621bd120Smckusick ioformatted = UNFORMATTED;
730621bd120Smckusick }
731621bd120Smckusick else {
732621bd120Smckusick err("bad format descriptor");
733621bd120Smckusick ioformatted = UNFORMATTED;
734621bd120Smckusick ok = NO;
735621bd120Smckusick }
736621bd120Smckusick }
737621bd120Smckusick else
738621bd120Smckusick fmtp = NULL;
739621bd120Smckusick
740621bd120Smckusick endfmt:
741621bd120Smckusick if(intfile && ioformatted==UNFORMATTED)
742621bd120Smckusick {
743621bd120Smckusick err("unformatted internal I/O not allowed");
744621bd120Smckusick ok = NO;
745621bd120Smckusick }
746621bd120Smckusick if(!sequential && ioformatted==LISTDIRECTED)
747621bd120Smckusick {
748621bd120Smckusick err("direct list-directed I/O not allowed");
749621bd120Smckusick ok = NO;
750621bd120Smckusick }
751621bd120Smckusick if(!sequential && ioformatted==NAMEDIRECTED)
752621bd120Smckusick {
753621bd120Smckusick err("direct namelist I/O not allowed");
754621bd120Smckusick ok = NO;
755621bd120Smckusick }
756621bd120Smckusick
757621bd120Smckusick if( ! ok )
758621bd120Smckusick return;
759621bd120Smckusick
760621bd120Smckusick if (optimflag && ISCONST (fmtp))
761621bd120Smckusick fmtp = putconst ( (expptr) fmtp);
762621bd120Smckusick
763621bd120Smckusick /*
764621bd120Smckusick Now put out the I/O structure, statically if all the clauses
765621bd120Smckusick are constants, dynamically otherwise
766621bd120Smckusick */
767621bd120Smckusick
768621bd120Smckusick if(statstruct)
769621bd120Smckusick {
770621bd120Smckusick tioblkp = ioblkp;
771621bd120Smckusick ioblkp = ALLOC(Addrblock);
772621bd120Smckusick ioblkp->tag = TADDR;
773621bd120Smckusick ioblkp->vtype = TYIOINT;
774621bd120Smckusick ioblkp->vclass = CLVAR;
775621bd120Smckusick ioblkp->vstg = STGINIT;
776621bd120Smckusick ioblkp->memno = ++lastvarno;
777621bd120Smckusick ioblkp->memoffset = ICON(0);
778621bd120Smckusick blklen = (intfile ? XIREC+SZIOINT :
779621bd120Smckusick (sequential ? XFMT+SZADDR : XRNUM+SZIOINT) );
780621bd120Smckusick t = ALLOC(IoBlock);
781621bd120Smckusick t->blkno = ioblkp->memno;
782621bd120Smckusick t->len = blklen;
783621bd120Smckusick t->next = iodata;
784621bd120Smckusick iodata = t;
785621bd120Smckusick }
786621bd120Smckusick else if(ioblkp == NULL)
787621bd120Smckusick ioblkp = autovar( (MAXIO+SZIOINT-1)/SZIOINT , TYIOINT, PNULL);
788621bd120Smckusick
789621bd120Smckusick ioset(TYIOINT, XERR, ICON(errbit));
790621bd120Smckusick if(iostmt == IOREAD)
791621bd120Smckusick ioset(TYIOINT, (intfile ? XIEND : XEND), ICON(endbit) );
792621bd120Smckusick
793621bd120Smckusick if(intfile)
794621bd120Smckusick {
795621bd120Smckusick ioset(TYIOINT, XIRNUM, nump);
7968d7b78deSdonn ioseta(XIUNIT, cpexpr(unitp));
797621bd120Smckusick ioset(TYIOINT, XIRLEN, cpexpr(unitp->vleng) );
7988d7b78deSdonn frexpr(unitp);
799621bd120Smckusick }
800621bd120Smckusick else
801621bd120Smckusick ioset(TYIOINT, XUNIT, (expptr) unitp);
802621bd120Smckusick
803621bd120Smckusick if(recp)
804621bd120Smckusick ioset(TYIOINT, (intfile ? XIREC : XREC) , (expptr) recp);
805621bd120Smckusick
806621bd120Smckusick if(varfmt)
807621bd120Smckusick ioseta( intfile ? XIFMT : XFMT , fmtp);
808621bd120Smckusick else
809621bd120Smckusick ioset(TYADDR, intfile ? XIFMT : XFMT, (expptr) fmtp);
810621bd120Smckusick
811621bd120Smckusick ioroutine[0] = 's';
812621bd120Smckusick ioroutine[1] = '_';
813621bd120Smckusick ioroutine[2] = (iostmt==IOREAD ? 'r' : 'w');
814621bd120Smckusick ioroutine[3] = (sequential ? 's' : 'd');
815621bd120Smckusick ioroutine[4] = "ufln" [ioformatted];
816621bd120Smckusick ioroutine[5] = (intfile ? 'i' : 'e');
817621bd120Smckusick ioroutine[6] = '\0';
818621bd120Smckusick
819621bd120Smckusick putiocall( call1(TYINT, ioroutine, cpexpr(ioblkp) ));
820621bd120Smckusick
821621bd120Smckusick if(statstruct)
822621bd120Smckusick {
823621bd120Smckusick frexpr(ioblkp);
824621bd120Smckusick ioblkp = tioblkp;
825621bd120Smckusick statstruct = NO;
826621bd120Smckusick }
827621bd120Smckusick }
828621bd120Smckusick
829621bd120Smckusick
830621bd120Smckusick
dofopen()831621bd120Smckusick LOCAL dofopen()
832621bd120Smckusick {
833621bd120Smckusick register expptr p;
834621bd120Smckusick
835621bd120Smckusick if( (p = V(IOSUNIT)) && ISINT(p->headblock.vtype) )
836621bd120Smckusick ioset(TYIOINT, XUNIT, cpexpr(p) );
837621bd120Smckusick else
838621bd120Smckusick err("bad unit in open");
839621bd120Smckusick if( (p = V(IOSFILE)) )
840621bd120Smckusick if(p->headblock.vtype == TYCHAR)
841621bd120Smckusick ioset(TYIOINT, XFNAMELEN, cpexpr(p->headblock.vleng) );
842621bd120Smckusick else
843621bd120Smckusick err("bad file in open");
844621bd120Smckusick
845621bd120Smckusick iosetc(XFNAME, p);
846621bd120Smckusick
847621bd120Smckusick if(p = V(IOSRECL))
848621bd120Smckusick if( ISINT(p->headblock.vtype) )
849621bd120Smckusick ioset(TYIOINT, XRECLEN, cpexpr(p) );
850621bd120Smckusick else
851621bd120Smckusick err("bad recl");
852621bd120Smckusick else
853621bd120Smckusick ioset(TYIOINT, XRECLEN, ICON(0) );
854621bd120Smckusick
855621bd120Smckusick iosetc(XSTATUS, V(IOSSTATUS));
856621bd120Smckusick iosetc(XACCESS, V(IOSACCESS));
857621bd120Smckusick iosetc(XFORMATTED, V(IOSFORM));
858621bd120Smckusick iosetc(XBLANK, V(IOSBLANK));
859621bd120Smckusick
860621bd120Smckusick putiocall( call1(TYINT, "f_open", cpexpr(ioblkp) ));
861621bd120Smckusick }
862621bd120Smckusick
863621bd120Smckusick
dofclose()864621bd120Smckusick LOCAL dofclose()
865621bd120Smckusick {
866621bd120Smckusick register expptr p;
867621bd120Smckusick
868621bd120Smckusick if( (p = V(IOSUNIT)) && ISINT(p->headblock.vtype) )
869621bd120Smckusick {
870621bd120Smckusick ioset(TYIOINT, XUNIT, cpexpr(p) );
871621bd120Smckusick iosetc(XCLSTATUS, V(IOSSTATUS));
872621bd120Smckusick putiocall( call1(TYINT, "f_clos", cpexpr(ioblkp)) );
873621bd120Smckusick }
874621bd120Smckusick else
875621bd120Smckusick err("bad unit in close statement");
876621bd120Smckusick }
877621bd120Smckusick
878621bd120Smckusick
dofinquire()879621bd120Smckusick LOCAL dofinquire()
880621bd120Smckusick {
881621bd120Smckusick register expptr p;
882621bd120Smckusick if(p = V(IOSUNIT))
883621bd120Smckusick {
884621bd120Smckusick if( V(IOSFILE) )
885621bd120Smckusick err("inquire by unit or by file, not both");
886621bd120Smckusick ioset(TYIOINT, XUNIT, cpexpr(p) );
887621bd120Smckusick }
888621bd120Smckusick else if( ! V(IOSFILE) )
889621bd120Smckusick err("must inquire by unit or by file");
890621bd120Smckusick iosetlc(IOSFILE, XFILE, XFILELEN);
891621bd120Smckusick iosetip(IOSEXISTS, XEXISTS);
892621bd120Smckusick iosetip(IOSOPENED, XOPEN);
893621bd120Smckusick iosetip(IOSNUMBER, XNUMBER);
894621bd120Smckusick iosetip(IOSNAMED, XNAMED);
895621bd120Smckusick iosetlc(IOSNAME, XNAME, XNAMELEN);
896621bd120Smckusick iosetlc(IOSACCESS, XQACCESS, XQACCLEN);
897621bd120Smckusick iosetlc(IOSSEQUENTIAL, XSEQ, XSEQLEN);
898621bd120Smckusick iosetlc(IOSDIRECT, XDIRECT, XDIRLEN);
899621bd120Smckusick iosetlc(IOSFORM, XFORM, XFORMLEN);
900621bd120Smckusick iosetlc(IOSFORMATTED, XFMTED, XFMTEDLEN);
901621bd120Smckusick iosetlc(IOSUNFORMATTED, XUNFMT, XUNFMTLEN);
902621bd120Smckusick iosetip(IOSRECL, XQRECL);
903621bd120Smckusick iosetip(IOSNEXTREC, XNEXTREC);
904621bd120Smckusick iosetlc(IOSBLANK, XQBLANK, XQBLANKLEN);
905621bd120Smckusick
906621bd120Smckusick putiocall( call1(TYINT, "f_inqu", cpexpr(ioblkp) ));
907621bd120Smckusick }
908621bd120Smckusick
909621bd120Smckusick
910621bd120Smckusick
dofmove(subname)911621bd120Smckusick LOCAL dofmove(subname)
912621bd120Smckusick char *subname;
913621bd120Smckusick {
914621bd120Smckusick register expptr p;
915621bd120Smckusick
916621bd120Smckusick if( (p = V(IOSUNIT)) && ISINT(p->headblock.vtype) )
917621bd120Smckusick {
918621bd120Smckusick ioset(TYIOINT, XUNIT, cpexpr(p) );
919621bd120Smckusick putiocall( call1(TYINT, subname, cpexpr(ioblkp) ));
920621bd120Smckusick }
921621bd120Smckusick else
922621bd120Smckusick err("bad unit in I/O motion statement");
923621bd120Smckusick }
924621bd120Smckusick
925621bd120Smckusick
926621bd120Smckusick
927621bd120Smckusick LOCAL
ioset(type,offset,p)928621bd120Smckusick ioset(type, offset, p)
929621bd120Smckusick int type;
930621bd120Smckusick int offset;
931621bd120Smckusick register expptr p;
932621bd120Smckusick {
933621bd120Smckusick static char *badoffset = "badoffset in ioset";
934621bd120Smckusick
935621bd120Smckusick register Addrp q;
936621bd120Smckusick register offsetlist *op;
937621bd120Smckusick
938621bd120Smckusick q = (Addrp) cpexpr(ioblkp);
939621bd120Smckusick q->vtype = type;
940621bd120Smckusick q->memoffset = fixtype( mkexpr(OPPLUS, q->memoffset, ICON(offset)) );
941621bd120Smckusick
942621bd120Smckusick if (statstruct && ISCONST(p))
943621bd120Smckusick {
944621bd120Smckusick if (!ISICON(q->memoffset))
945621bd120Smckusick fatal(badoffset);
946621bd120Smckusick
9479e02124eSbostic op = mkiodata(q->memno, q->memoffset->constblock.constant.ci, blklen);
948621bd120Smckusick if (op->tag != 0)
949621bd120Smckusick fatal(badoffset);
950621bd120Smckusick
951621bd120Smckusick if (type == TYADDR)
952621bd120Smckusick {
953621bd120Smckusick op->tag = NDLABEL;
9549e02124eSbostic op->val.label = p->constblock.constant.ci;
955621bd120Smckusick }
956621bd120Smckusick else
957621bd120Smckusick {
958621bd120Smckusick op->tag = NDDATA;
959621bd120Smckusick op->val.cp = (Constp) convconst(type, 0, p);
960621bd120Smckusick }
961621bd120Smckusick
962621bd120Smckusick frexpr((tagptr) p);
963621bd120Smckusick frexpr((tagptr) q);
964621bd120Smckusick }
965621bd120Smckusick else
966621bd120Smckusick if (optimflag)
967621bd120Smckusick optbuff (SKEQ, mkexpr(OPASSIGN,q,p), 0,0);
968621bd120Smckusick else
969621bd120Smckusick puteq (q,p);
970621bd120Smckusick
971621bd120Smckusick return;
972621bd120Smckusick }
973621bd120Smckusick
974621bd120Smckusick
975621bd120Smckusick
976621bd120Smckusick
iosetc(offset,p)977621bd120Smckusick LOCAL iosetc(offset, p)
978621bd120Smckusick int offset;
979621bd120Smckusick register expptr p;
980621bd120Smckusick {
981621bd120Smckusick if(p == NULL)
982621bd120Smckusick ioset(TYADDR, offset, ICON(0) );
983621bd120Smckusick else if(p->headblock.vtype == TYCHAR)
984621bd120Smckusick ioset(TYADDR, offset, addrof(cpexpr(p) ));
985621bd120Smckusick else
986621bd120Smckusick err("non-character control clause");
987621bd120Smckusick }
988621bd120Smckusick
989621bd120Smckusick
990621bd120Smckusick
ioseta(offset,p)991621bd120Smckusick LOCAL ioseta(offset, p)
992621bd120Smckusick int offset;
993621bd120Smckusick register Addrp p;
994621bd120Smckusick {
995621bd120Smckusick static char *badoffset = "bad offset in ioseta";
996621bd120Smckusick
997621bd120Smckusick int blkno;
998621bd120Smckusick register offsetlist *op;
999621bd120Smckusick
1000621bd120Smckusick if(statstruct)
1001621bd120Smckusick {
1002621bd120Smckusick blkno = ioblkp->memno;
1003621bd120Smckusick op = mkiodata(blkno, offset, blklen);
1004621bd120Smckusick if (op->tag != 0)
1005621bd120Smckusick fatal(badoffset);
1006621bd120Smckusick
1007621bd120Smckusick if (p == NULL)
1008621bd120Smckusick op->tag = NDNULL;
1009621bd120Smckusick else if (p->tag == TADDR)
1010621bd120Smckusick {
1011621bd120Smckusick op->tag = NDADDR;
1012621bd120Smckusick op->val.addr.stg = p->vstg;
1013621bd120Smckusick op->val.addr.memno = p->memno;
10149e02124eSbostic op->val.addr.offset = p->memoffset->constblock.constant.ci;
1015621bd120Smckusick }
1016621bd120Smckusick else
1017621bd120Smckusick badtag("ioseta", p->tag);
1018621bd120Smckusick }
1019621bd120Smckusick else
1020621bd120Smckusick ioset(TYADDR, offset, p ? addrof(p) : ICON(0) );
1021621bd120Smckusick
1022621bd120Smckusick return;
1023621bd120Smckusick }
1024621bd120Smckusick
1025621bd120Smckusick
1026621bd120Smckusick
1027621bd120Smckusick
iosetip(i,offset)1028621bd120Smckusick LOCAL iosetip(i, offset)
1029621bd120Smckusick int i, offset;
1030621bd120Smckusick {
1031621bd120Smckusick register expptr p;
1032621bd120Smckusick
1033621bd120Smckusick if(p = V(i))
1034621bd120Smckusick if(p->tag==TADDR &&
1035621bd120Smckusick ONEOF(p->addrblock.vtype, M(TYLONG)|M(TYLOGICAL)) )
1036621bd120Smckusick ioset(TYADDR, offset, addrof(cpexpr(p)) );
1037621bd120Smckusick else
1038621bd120Smckusick errstr("impossible inquire parameter %s", ioc[i].iocname);
1039621bd120Smckusick else
1040621bd120Smckusick ioset(TYADDR, offset, ICON(0) );
1041621bd120Smckusick }
1042621bd120Smckusick
1043621bd120Smckusick
1044621bd120Smckusick
iosetlc(i,offp,offl)1045621bd120Smckusick LOCAL iosetlc(i, offp, offl)
1046621bd120Smckusick int i, offp, offl;
1047621bd120Smckusick {
1048621bd120Smckusick register expptr p;
1049621bd120Smckusick if( (p = V(i)) && p->headblock.vtype==TYCHAR)
1050621bd120Smckusick ioset(TYIOINT, offl, cpexpr(p->headblock.vleng) );
1051621bd120Smckusick iosetc(offp, p);
1052621bd120Smckusick }
1053621bd120Smckusick
1054621bd120Smckusick
1055621bd120Smckusick LOCAL offsetlist *
mkiodata(blkno,offset,len)1056621bd120Smckusick mkiodata(blkno, offset, len)
1057621bd120Smckusick int blkno;
1058621bd120Smckusick ftnint offset;
1059621bd120Smckusick ftnint len;
1060621bd120Smckusick {
1061621bd120Smckusick register offsetlist *p, *q;
1062621bd120Smckusick register ioblock *t;
1063621bd120Smckusick register int found;
1064621bd120Smckusick
1065621bd120Smckusick found = NO;
1066621bd120Smckusick t = iodata;
1067621bd120Smckusick
1068621bd120Smckusick while (found == NO && t != NULL)
1069621bd120Smckusick {
1070621bd120Smckusick if (t->blkno == blkno)
1071621bd120Smckusick found = YES;
1072621bd120Smckusick else
1073621bd120Smckusick t = t->next;
1074621bd120Smckusick }
1075621bd120Smckusick
1076621bd120Smckusick if (found == NO)
1077621bd120Smckusick {
1078621bd120Smckusick t = ALLOC(IoBlock);
1079621bd120Smckusick t->blkno = blkno;
1080621bd120Smckusick t->next = iodata;
1081621bd120Smckusick iodata = t;
1082621bd120Smckusick }
1083621bd120Smckusick
1084621bd120Smckusick if (len > t->len)
1085621bd120Smckusick t->len = len;
1086621bd120Smckusick
1087621bd120Smckusick p = t->olist;
1088621bd120Smckusick
1089621bd120Smckusick if (p == NULL)
1090621bd120Smckusick {
1091621bd120Smckusick p = ALLOC(OffsetList);
1092621bd120Smckusick p->next = NULL;
1093621bd120Smckusick p->offset = offset;
1094621bd120Smckusick t->olist = p;
1095621bd120Smckusick return (p);
1096621bd120Smckusick }
1097621bd120Smckusick
1098621bd120Smckusick for (;;)
1099621bd120Smckusick {
1100621bd120Smckusick if (p->offset == offset)
1101621bd120Smckusick return (p);
1102621bd120Smckusick else if (p->next != NULL &&
1103621bd120Smckusick p->next->offset <= offset)
1104621bd120Smckusick p = p->next;
1105621bd120Smckusick else
1106621bd120Smckusick {
1107621bd120Smckusick q = ALLOC(OffsetList);
1108621bd120Smckusick q->next = p->next;
1109621bd120Smckusick p->next = q;
1110621bd120Smckusick q->offset = offset;
1111621bd120Smckusick return (q);
1112621bd120Smckusick }
1113621bd120Smckusick }
1114621bd120Smckusick }
1115621bd120Smckusick
1116621bd120Smckusick
outiodata()1117621bd120Smckusick outiodata()
1118621bd120Smckusick {
1119621bd120Smckusick static char *varfmt = "v.%d:\n";
1120621bd120Smckusick
1121621bd120Smckusick register ioblock *p;
1122621bd120Smckusick register ioblock *t;
1123621bd120Smckusick
1124621bd120Smckusick if (iodata == NULL) return;
1125621bd120Smckusick
1126621bd120Smckusick p = iodata;
1127621bd120Smckusick
1128621bd120Smckusick while (p != NULL)
1129621bd120Smckusick {
1130621bd120Smckusick pralign(ALIDOUBLE);
1131621bd120Smckusick fprintf(initfile, varfmt, p->blkno);
1132621bd120Smckusick outolist(p->olist, p->len);
1133621bd120Smckusick
1134621bd120Smckusick t = p;
1135621bd120Smckusick p = t->next;
1136621bd120Smckusick free((char *) t);
1137621bd120Smckusick }
1138621bd120Smckusick
1139621bd120Smckusick iodata = NULL;
1140621bd120Smckusick return;
1141621bd120Smckusick }
1142621bd120Smckusick
1143621bd120Smckusick
1144621bd120Smckusick
1145621bd120Smckusick LOCAL
outolist(op,len)1146621bd120Smckusick outolist(op, len)
1147621bd120Smckusick register offsetlist *op;
1148621bd120Smckusick register int len;
1149621bd120Smckusick {
1150621bd120Smckusick static char *overlap = "overlapping i/o fields in outolist";
1151621bd120Smckusick static char *toolong = "offset too large in outolist";
1152621bd120Smckusick
1153621bd120Smckusick register offsetlist *t;
1154621bd120Smckusick register ftnint clen;
1155621bd120Smckusick register Constp cp;
1156621bd120Smckusick register int type;
1157621bd120Smckusick
1158621bd120Smckusick clen = 0;
1159621bd120Smckusick
1160621bd120Smckusick while (op != NULL)
1161621bd120Smckusick {
1162621bd120Smckusick if (clen > op->offset)
1163621bd120Smckusick fatal(overlap);
1164621bd120Smckusick
1165621bd120Smckusick if (clen < op->offset)
1166621bd120Smckusick {
1167621bd120Smckusick prspace(op->offset - clen);
1168621bd120Smckusick clen = op->offset;
1169621bd120Smckusick }
1170621bd120Smckusick
1171621bd120Smckusick switch (op->tag)
1172621bd120Smckusick {
1173621bd120Smckusick default:
1174621bd120Smckusick badtag("outolist", op->tag);
1175621bd120Smckusick
1176621bd120Smckusick case NDDATA:
1177621bd120Smckusick cp = op->val.cp;
1178621bd120Smckusick type = cp->vtype;
1179621bd120Smckusick if (type != TYIOINT)
1180621bd120Smckusick badtype("outolist", type);
11819e02124eSbostic prconi(initfile, type, cp->constant.ci);
1182621bd120Smckusick clen += typesize[type];
1183621bd120Smckusick frexpr((tagptr) cp);
1184621bd120Smckusick break;
1185621bd120Smckusick
1186621bd120Smckusick case NDLABEL:
1187621bd120Smckusick prcona(initfile, op->val.label);
1188621bd120Smckusick clen += typesize[TYADDR];
1189621bd120Smckusick break;
1190621bd120Smckusick
1191621bd120Smckusick case NDADDR:
1192621bd120Smckusick praddr(initfile, op->val.addr.stg, op->val.addr.memno,
1193621bd120Smckusick op->val.addr.offset);
1194621bd120Smckusick clen += typesize[TYADDR];
1195621bd120Smckusick break;
1196621bd120Smckusick
1197621bd120Smckusick case NDNULL:
1198621bd120Smckusick praddr(initfile, STGNULL, 0, (ftnint) 0);
1199621bd120Smckusick clen += typesize[TYADDR];
1200621bd120Smckusick break;
1201621bd120Smckusick }
1202621bd120Smckusick
1203621bd120Smckusick t = op;
1204621bd120Smckusick op = t->next;
1205621bd120Smckusick free((char *) t);
1206621bd120Smckusick }
1207621bd120Smckusick
1208621bd120Smckusick if (clen > len)
1209621bd120Smckusick fatal(toolong);
1210621bd120Smckusick
1211621bd120Smckusick if (clen < len)
1212621bd120Smckusick prspace(len - clen);
1213621bd120Smckusick
1214621bd120Smckusick return;
1215621bd120Smckusick }
1216