source: mainline/uspace/app/pcc/f77/fcom/io.c@ c6a7b3a

lfn serial ticket/834-toolchain-update topic/msim-upgrade topic/simplify-dev-export
Last change on this file since c6a7b3a was a7de7182, checked in by Jiří Zárevúcky <zarevucky.jiri@…>, 14 years ago

Added pcc source tree (contents of pcc-1.0.0.tgz)
  • Property mode set to 100644
File size: 16.3 KB
Line 
1/* $Id: io.c,v 1.15 2008/12/19 08:08:48 ragge Exp $ */
2/*
3 * Copyright(C) Caldera International Inc. 2001-2002. All rights reserved.
4 *
5 * Redistribution and use in source and binary forms, with or without
6 * modification, are permitted provided that the following conditions
7 * are met:
8 *
9 * Redistributions of source code and documentation must retain the above
10 * copyright notice, this list of conditions and the following disclaimer.
11 * Redistributions in binary form must reproduce the above copyright
12 * notice, this list of conditions and the following disclaimer in the
13 * documentation and/or other materials provided with the distribution.
14 * All advertising materials mentioning features or use of this software
15 * must display the following acknowledgement:
16 * This product includes software developed or owned by Caldera
17 * International, Inc.
18 * Neither the name of Caldera International, Inc. nor the names of other
19 * contributors may be used to endorse or promote products derived from
20 * this software without specific prior written permission.
21 *
22 * USE OF THE SOFTWARE PROVIDED FOR UNDER THIS LICENSE BY CALDERA
23 * INTERNATIONAL, INC. AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR
24 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
25 * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
26 * DISCLAIMED. IN NO EVENT SHALL CALDERA INTERNATIONAL, INC. BE LIABLE
27 * FOR ANY DIRECT, INDIRECT INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
28 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
29 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
30 * HOWEVER CAUSED AND ON ANY THEORY OFLIABILITY, WHETHER IN CONTRACT,
31 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
32 * IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
33 * POSSIBILITY OF SUCH DAMAGE.
34 */
35/* TEMPORARY */
36#define TYIOINT TYLONG
37#define FSZIOINT FSZLONG
38
39#include <string.h>
40
41#include "defines.h"
42#include "defs.h"
43
44LOCAL void doiolist(chainp);
45LOCAL void dofopen(void);
46LOCAL void dofclose(void);
47LOCAL void dofinquire(void);
48LOCAL void dofmove(char *);
49LOCAL void ioset(int, int, bigptr);
50LOCAL void iosetc(int, bigptr);
51LOCAL void iosetip(int, int);
52LOCAL void iosetlc(int, int, int);
53LOCAL void putiocall(struct bigblock *q);
54LOCAL void putio(bigptr, bigptr);
55LOCAL void startrw(void);
56
57
58LOCAL char ioroutine[XL+1];
59
60LOCAL int ioendlab;
61LOCAL int ioerrlab;
62LOCAL int endbit;
63LOCAL int jumplab;
64LOCAL int skiplab;
65LOCAL int ioformatted;
66
67#define UNFORMATTED 0
68#define FORMATTED 1
69#define LISTDIRECTED 2
70
71#define V(z) ioc[z].iocval
72
73#define IOALL 07777
74
75LOCAL struct ioclist
76 {
77 char *iocname;
78 int iotype;
79 bigptr iocval;
80 } ioc[ ] =
81 {
82 { "", 0 },
83 { "unit", IOALL },
84 { "fmt", M(IOREAD) | M(IOWRITE) },
85 { "err", IOALL },
86 { "end", M(IOREAD) },
87 { "iostat", IOALL },
88 { "rec", M(IOREAD) | M(IOWRITE) },
89 { "recl", M(IOOPEN) | M(IOINQUIRE) },
90 { "file", M(IOOPEN) | M(IOINQUIRE) },
91 { "status", M(IOOPEN) | M(IOCLOSE) },
92 { "access", M(IOOPEN) | M(IOINQUIRE) },
93 { "form", M(IOOPEN) | M(IOINQUIRE) },
94 { "blank", M(IOOPEN) | M(IOINQUIRE) },
95 { "exist", M(IOINQUIRE) },
96 { "opened", M(IOINQUIRE) },
97 { "number", M(IOINQUIRE) },
98 { "named", M(IOINQUIRE) },
99 { "name", M(IOINQUIRE) },
100 { "sequential", M(IOINQUIRE) },
101 { "direct", M(IOINQUIRE) },
102 { "formatted", M(IOINQUIRE) },
103 { "unformatted", M(IOINQUIRE) },
104 { "nextrec", M(IOINQUIRE) }
105 } ;
106
107#define NIOS (sizeof(ioc)/sizeof(struct ioclist) - 1)
108#define MAXIO FSZFLAG + 10*FSZIOINT + 15*FSZADDR
109
110#define IOSUNIT 1
111#define IOSFMT 2
112#define IOSERR 3
113#define IOSEND 4
114#define IOSIOSTAT 5
115#define IOSREC 6
116#define IOSRECL 7
117#define IOSFILE 8
118#define IOSSTATUS 9
119#define IOSACCESS 10
120#define IOSFORM 11
121#define IOSBLANK 12
122#define IOSEXISTS 13
123#define IOSOPENED 14
124#define IOSNUMBER 15
125#define IOSNAMED 16
126#define IOSNAME 17
127#define IOSSEQUENTIAL 18
128#define IOSDIRECT 19
129#define IOSFORMATTED 20
130#define IOSUNFORMATTED 21
131#define IOSNEXTREC 22
132
133#define IOSTP V(IOSIOSTAT)
134
135
136/* offsets in generated structures */
137
138#define FSZFLAG FSZIOINT
139
140#define XERR 0
141#define XUNIT FSZFLAG
142#define XEND FSZFLAG + FSZIOINT
143#define XFMT 2*FSZFLAG + FSZIOINT
144#define XREC 2*FSZFLAG + FSZIOINT + FSZADDR
145#define XRLEN 2*FSZFLAG + 2*FSZADDR
146#define XRNUM 2*FSZFLAG + 2*FSZADDR + FSZIOINT
147
148#define XIFMT 2*FSZFLAG + FSZADDR
149#define XIEND FSZFLAG + FSZADDR
150#define XIUNIT FSZFLAG
151
152#define XFNAME FSZFLAG + FSZIOINT
153#define XFNAMELEN FSZFLAG + FSZIOINT + FSZADDR
154#define XSTATUS FSZFLAG + 2*FSZIOINT + FSZADDR
155#define XACCESS FSZFLAG + 2*FSZIOINT + 2*FSZADDR
156#define XFORMATTED FSZFLAG + 2*FSZIOINT + 3*FSZADDR
157#define XRECLEN FSZFLAG + 2*FSZIOINT + 4*FSZADDR
158#define XBLANK FSZFLAG + 3*FSZIOINT + 4*FSZADDR
159
160#define XCLSTATUS FSZFLAG + FSZIOINT
161
162#define XFILE FSZFLAG + FSZIOINT
163#define XFILELEN FSZFLAG + FSZIOINT + FSZADDR
164#define XEXISTS FSZFLAG + 2*FSZIOINT + FSZADDR
165#define XOPEN FSZFLAG + 2*FSZIOINT + 2*FSZADDR
166#define XNUMBER FSZFLAG + 2*FSZIOINT + 3*FSZADDR
167#define XNAMED FSZFLAG + 2*FSZIOINT + 4*FSZADDR
168#define XNAME FSZFLAG + 2*FSZIOINT + 5*FSZADDR
169#define XNAMELEN FSZFLAG + 2*FSZIOINT + 6*FSZADDR
170#define XQACCESS FSZFLAG + 3*FSZIOINT + 6*FSZADDR
171#define XQACCLEN FSZFLAG + 3*FSZIOINT + 7*FSZADDR
172#define XSEQ FSZFLAG + 4*FSZIOINT + 7*FSZADDR
173#define XSEQLEN FSZFLAG + 4*FSZIOINT + 8*FSZADDR
174#define XDIRECT FSZFLAG + 5*FSZIOINT + 8*FSZADDR
175#define XDIRLEN FSZFLAG + 5*FSZIOINT + 9*FSZADDR
176#define XFORM FSZFLAG + 6*FSZIOINT + 9*FSZADDR
177#define XFORMLEN FSZFLAG + 6*FSZIOINT + 10*FSZADDR
178#define XFMTED FSZFLAG + 7*FSZIOINT + 10*FSZADDR
179#define XFMTEDLEN FSZFLAG + 7*FSZIOINT + 11*FSZADDR
180#define XUNFMT FSZFLAG + 8*FSZIOINT + 11*FSZADDR
181#define XUNFMTLEN FSZFLAG + 8*FSZIOINT + 12*FSZADDR
182#define XQRECL FSZFLAG + 9*FSZIOINT + 12*FSZADDR
183#define XNEXTREC FSZFLAG + 9*FSZIOINT + 13*FSZADDR
184#define XQBLANK FSZFLAG + 9*FSZIOINT + 14*FSZADDR
185#define XQBLANKLEN FSZFLAG + 9*FSZIOINT + 15*FSZADDR
186
187
188int
189fmtstmt(lp)
190register struct labelblock *lp;
191{
192if(lp == NULL)
193 {
194 execerr("unlabeled format statement" , 0);
195 return(-1);
196 }
197if(lp->labtype == LABUNKNOWN)
198 {
199 lp->labtype = LABFORMAT;
200 lp->labelno = newlabel();
201 }
202else if(lp->labtype != LABFORMAT)
203 {
204 execerr("bad format number", 0);
205 return(-1);
206 }
207return(lp->labelno);
208}
209
210
211void
212setfmt(struct labelblock *lp)
213{
214 ftnint n;
215 char *s;
216
217 s = lexline(&n);
218 preven(ALILONG);
219 prlabel(lp->labelno);
220 putstr(s, n);
221 flline();
222}
223
224
225void
226startioctl()
227{
228unsigned int i;
229
230inioctl = YES;
231nioctl = 0;
232ioerrlab = 0;
233ioformatted = UNFORMATTED;
234for(i = 1 ; i<=NIOS ; ++i)
235 V(i) = NULL;
236}
237
238
239void
240endioctl()
241{
242unsigned int i;
243bigptr p;
244
245inioctl = NO;
246if(ioblkp == NULL)
247 ioblkp = autovar( (MAXIO+FSZIOINT-1)/FSZIOINT , TYIOINT, NULL);
248
249/* set up for error recovery */
250
251ioerrlab = ioendlab = skiplab = jumplab = 0;
252
253if((p = V(IOSEND))) {
254 if(ISICON(p))
255 ioendlab = mklabel(p->b_const.fconst.ci)->labelno;
256 else
257 err("bad end= clause");
258}
259
260if((p = V(IOSERR))) {
261 if(ISICON(p))
262 ioerrlab = mklabel(p->b_const.fconst.ci)->labelno;
263 else
264 err("bad err= clause");
265}
266
267if(IOSTP==NULL && ioerrlab!=0 && ioendlab!=0 && ioerrlab!=ioendlab)
268 IOSTP = fmktemp(TYINT, NULL);
269
270if(IOSTP != NULL) {
271 if(IOSTP->tag!=TADDR || ! ISINT(IOSTP->vtype) )
272 {
273 err("iostat must be an integer variable");
274 frexpr(IOSTP);
275 IOSTP = NULL;
276 }
277}
278
279if(IOSTP)
280 {
281 if( (iostmt==IOREAD || iostmt==IOWRITE) &&
282 (ioerrlab!=ioendlab || ioerrlab==0) )
283 jumplab = skiplab = newlabel();
284 else
285 jumplab = ioerrlab;
286 }
287else
288 {
289 jumplab = ioerrlab;
290 if(ioendlab)
291 jumplab = ioendlab;
292 }
293
294ioset(TYIOINT, XERR, MKICON(IOSTP!=NULL || ioerrlab!=0) );
295endbit = IOSTP!=NULL || ioendlab!=0; /* for use in startrw() */
296
297switch(iostmt)
298 {
299 case IOOPEN:
300 dofopen(); break;
301
302 case IOCLOSE:
303 dofclose(); break;
304
305 case IOINQUIRE:
306 dofinquire(); break;
307
308 case IOBACKSPACE:
309 dofmove("f_back"); break;
310
311 case IOREWIND:
312 dofmove("f_rew"); break;
313
314 case IOENDFILE:
315 dofmove("f_end"); break;
316
317 case IOREAD:
318 case IOWRITE:
319 startrw(); break;
320
321 default:
322 fatal1("impossible iostmt %d", iostmt);
323 }
324for(i = 1 ; i<=NIOS ; ++i)
325 if(i!=IOSIOSTAT || (iostmt!=IOREAD && iostmt!=IOWRITE) )
326 frexpr(V(i));
327}
328
329
330int
331iocname()
332{
333unsigned int i;
334int found, mask;
335
336found = 0;
337mask = M(iostmt);
338for(i = 1 ; i <= NIOS ; ++i) {
339 if(toklen==(int)strlen(ioc[i].iocname) && eqn(toklen, token, ioc[i].iocname)) {
340 if(ioc[i].iotype & mask)
341 return(i);
342 else found = i;
343 }
344}
345
346if(found)
347 err1("invalid control %s for statement", ioc[found].iocname);
348else
349 err1("unknown iocontrol %s", varstr(toklen, token) );
350return(IOSBAD);
351}
352
353void
354ioclause(n, p)
355register int n;
356register bigptr p;
357{
358struct ioclist *iocp;
359
360++nioctl;
361if(n == IOSBAD)
362 return;
363if(n == IOSPOSITIONAL)
364 {
365 if(nioctl > IOSFMT)
366 {
367 err("illegal positional iocontrol");
368 return;
369 }
370 n = nioctl;
371 }
372
373if(p == NULL)
374 {
375 if(n == IOSUNIT)
376 p = (iostmt==IOREAD ? IOSTDIN : IOSTDOUT);
377 else if(n != IOSFMT)
378 {
379 err("illegal * iocontrol");
380 return;
381 }
382 }
383if(n == IOSFMT)
384 ioformatted = (p==NULL ? LISTDIRECTED : FORMATTED);
385
386iocp = & ioc[n];
387if(iocp->iocval == NULL)
388 {
389 p = cpexpr(p);
390 if(n!=IOSFMT && ( n!=IOSUNIT || (p!=NULL && p->vtype!=TYCHAR) ) )
391 p = fixtype(p);
392 iocp->iocval = p;
393}
394else
395 err1("iocontrol %s repeated", iocp->iocname);
396}
397
398/* io list item */
399void
400doio(list)
401chainp list;
402{
403doiolist(list);
404ioroutine[0] = 'e';
405putiocall( call0(TYINT, ioroutine) );
406frexpr(IOSTP);
407}
408
409
410
411
412
413LOCAL void doiolist(p0)
414chainp p0;
415{
416chainp p;
417register bigptr q;
418register bigptr qe;
419register struct bigblock *qn;
420struct bigblock *tp;
421int range;
422
423for (p = p0 ; p ; p = p->chain.nextp)
424 {
425 q = p->chain.datap;
426 if(q->tag == TIMPLDO)
427 {
428 exdo(range=newlabel(), (chainp)q->b_impldo.varnp);
429 doiolist(q->b_impldo.datalist);
430 enddo(range);
431 ckfree(q);
432 }
433 else {
434 if(q->tag==TPRIM && q->b_prim.argsp==NULL && q->b_prim.namep->b_name.vdim!=NULL)
435 {
436 vardcl(qn = q->b_prim.namep);
437 if(qn->b_name.vdim->nelt)
438 putio( fixtype(cpexpr(qn->b_name.vdim->nelt)),
439 mkscalar(qn) );
440 else
441 err("attempt to i/o array of unknown size");
442 }
443 else if(q->tag==TPRIM && q->b_prim.argsp==NULL && (qe = memversion(q->b_prim.namep)) )
444 putio(MKICON(1),qe);
445 else if( (qe = fixtype(cpexpr(q)))->tag==TADDR)
446 putio(MKICON(1), qe);
447 else if(qe->vtype != TYERROR)
448 {
449 if(iostmt == IOWRITE)
450 {
451 tp = fmktemp(qe->vtype, qe->vleng);
452 puteq( cpexpr(tp), qe);
453 putio(MKICON(1), tp);
454 }
455 else
456 err("non-left side in READ list");
457 }
458 frexpr(q);
459 }
460 }
461frchain( &p0 );
462}
463
464
465
466
467
468LOCAL void
469putio(nelt, addr)
470bigptr nelt;
471register bigptr addr;
472{
473int type;
474register struct bigblock *q;
475
476type = addr->vtype;
477if(ioformatted!=LISTDIRECTED && ISCOMPLEX(type) )
478 {
479 nelt = mkexpr(OPSTAR, MKICON(2), nelt);
480 type -= (TYCOMPLEX-TYREAL);
481 }
482
483/* pass a length with every item. for noncharacter data, fake one */
484if(type != TYCHAR)
485 {
486 if( ISCONST(addr) )
487 addr = putconst(addr);
488 addr->vtype = TYCHAR;
489 addr->vleng = MKICON( typesize[type] );
490 }
491
492nelt = fixtype( mkconv(TYLENG,nelt) );
493if(ioformatted == LISTDIRECTED)
494 q = call3(TYINT, "do_lio", mkconv(TYLONG, MKICON(type)), nelt, addr);
495else
496 q = call2(TYINT, (ioformatted==FORMATTED ? "do_fio" : "do_uio"),
497 nelt, addr);
498putiocall(q);
499}
500
501
502
503void
504endio()
505{
506if(skiplab)
507 {
508 putlabel(skiplab);
509 if(ioendlab)
510 putif( mkexpr(OPGE, cpexpr(IOSTP), MKICON(0)), ioendlab);
511 if(ioerrlab)
512 putif( mkexpr( ( (iostmt==IOREAD||iostmt==IOWRITE) ? OPLE : OPEQ),
513 cpexpr(IOSTP), MKICON(0)) , ioerrlab);
514 }
515if(IOSTP)
516 frexpr(IOSTP);
517}
518
519
520
521LOCAL void
522putiocall(q)
523register struct bigblock *q;
524{
525if(IOSTP)
526 {
527 q->vtype = TYINT;
528 q = fixexpr( mkexpr(OPASSIGN, cpexpr(IOSTP), q));
529 }
530
531if(jumplab)
532 putif( mkexpr(OPEQ, q, MKICON(0) ), jumplab);
533else
534 putexpr(q);
535}
536
537
538
539void
540startrw()
541{
542register bigptr p;
543register struct bigblock *np;
544register struct bigblock *unitp, *nump;
545int k, fmtoff;
546int intfile, sequential;
547
548
549sequential = YES;
550if((p = V(IOSREC))) {
551 if( ISINT(p->vtype) )
552 {
553 ioset(TYIOINT, XREC, cpexpr(p) );
554 sequential = NO;
555 }
556 else
557 err("bad REC= clause");
558}
559
560intfile = NO;
561if((p = V(IOSUNIT)))
562 {
563 if( ISINT(p->vtype) )
564 ioset(TYIOINT, XUNIT, cpexpr(p) );
565 else if(p->vtype == TYCHAR)
566 {
567 intfile = YES;
568 if(p->tag==TPRIM && p->b_prim.argsp==NULL && (np = p->b_prim.namep)->b_name.vdim!=NULL)
569 {
570 vardcl(np);
571 if(np->b_name.vdim->nelt)
572 nump = cpexpr(np->b_name.vdim->nelt);
573 else
574 {
575 err("attempt to use internal unit array of unknown size");
576 nump = MKICON(1);
577 }
578 unitp = mkscalar(np);
579 }
580 else {
581 nump = MKICON(1);
582 unitp = fixtype(cpexpr(p));
583 }
584 ioset(TYIOINT, XRNUM, nump);
585 ioset(TYIOINT, XRLEN, cpexpr(unitp->vleng) );
586 ioset(TYADDR, XUNIT, addrof(unitp) );
587 }
588 }
589else
590 err("bad unit specifier");
591
592if(iostmt == IOREAD)
593 ioset(TYIOINT, (intfile ? XIEND : XEND), MKICON(endbit) );
594
595fmtoff = (intfile ? XIFMT : XFMT);
596
597if((p = V(IOSFMT)))
598 {
599 if(p->tag==TPRIM && p->b_prim.argsp==NULL)
600 {
601 vardcl(np = p->b_prim.namep);
602 if(np->b_name.vdim)
603 {
604 ioset(TYADDR, fmtoff, addrof(mkscalar(np)) );
605 goto endfmt;
606 }
607 if( ISINT(np->vtype) )
608 {
609 ioset(TYADDR, fmtoff, cpexpr(p));
610 goto endfmt;
611 }
612 }
613 p = V(IOSFMT) = fixtype(p);
614 if(p->vtype == TYCHAR)
615 ioset(TYADDR, fmtoff, addrof(cpexpr(p)) );
616 else if( ISICON(p) )
617 {
618 if( (k = fmtstmt( mklabel(p->b_const.fconst.ci) )) > 0 )
619 ioset(TYADDR, fmtoff, mkaddcon(k) );
620 else
621 ioformatted = UNFORMATTED;
622 }
623 else {
624 err("bad format descriptor");
625 ioformatted = UNFORMATTED;
626 }
627 }
628else
629 ioset(TYADDR, fmtoff, MKICON(0) );
630
631endfmt:
632
633
634ioroutine[0] = 's';
635ioroutine[1] = '_';
636ioroutine[2] = (iostmt==IOREAD ? 'r' : 'w');
637ioroutine[3] = (sequential ? 's' : 'd');
638ioroutine[4] = "ufl" [ioformatted];
639ioroutine[5] = (intfile ? 'i' : 'e');
640ioroutine[6] = '\0';
641putiocall( call1(TYINT, ioroutine, cpexpr(ioblkp) ));
642}
643
644
645
646LOCAL void dofopen()
647{
648register bigptr p;
649
650if( (p = V(IOSUNIT)) && ISINT(p->vtype) )
651 ioset(TYIOINT, XUNIT, cpexpr(p) );
652else
653 err("bad unit in open");
654if( (p = V(IOSFILE)) && p->vtype==TYCHAR)
655 {
656 ioset(TYIOINT, XFNAMELEN, cpexpr(p->vleng) );
657 iosetc(XFNAME, p);
658 }
659else
660 err("bad file in open");
661
662if((p = V(IOSRECL)))
663 if( ISINT(p->vtype) )
664 ioset(TYIOINT, XRECLEN, cpexpr(p) );
665 else
666 err("bad recl");
667else
668 ioset(TYIOINT, XRECLEN, MKICON(0) );
669
670iosetc(XSTATUS, V(IOSSTATUS));
671iosetc(XACCESS, V(IOSACCESS));
672iosetc(XFORMATTED, V(IOSFORM));
673iosetc(XBLANK, V(IOSBLANK));
674
675putiocall( call1(TYINT, "f_open", cpexpr(ioblkp) ));
676}
677
678
679LOCAL void
680dofclose()
681{
682register bigptr p;
683
684if( (p = V(IOSUNIT)) && ISINT(p->vtype) )
685 {
686 ioset(TYIOINT, XUNIT, cpexpr(p) );
687 iosetc(XCLSTATUS, V(IOSSTATUS));
688 putiocall( call1(TYINT, "f_clos", cpexpr(ioblkp)) );
689 }
690else
691 err("bad unit in close statement");
692}
693
694
695LOCAL void dofinquire()
696{
697register bigptr p;
698if((p = V(IOSUNIT)))
699 {
700 if( V(IOSFILE) )
701 err("inquire by unit or by file, not both");
702 ioset(TYIOINT, XUNIT, cpexpr(p) );
703 }
704else if( ! V(IOSFILE) )
705 err("must inquire by unit or by file");
706iosetlc(IOSFILE, XFILE, XFILELEN);
707iosetip(IOSEXISTS, XEXISTS);
708iosetip(IOSOPENED, XOPEN);
709iosetip(IOSNUMBER, XNUMBER);
710iosetip(IOSNAMED, XNAMED);
711iosetlc(IOSNAME, XNAME, XNAMELEN);
712iosetlc(IOSACCESS, XQACCESS, XQACCLEN);
713iosetlc(IOSSEQUENTIAL, XSEQ, XSEQLEN);
714iosetlc(IOSDIRECT, XDIRECT, XDIRLEN);
715iosetlc(IOSFORM, XFORM, XFORMLEN);
716iosetlc(IOSFORMATTED, XFMTED, XFMTEDLEN);
717iosetlc(IOSUNFORMATTED, XUNFMT, XUNFMTLEN);
718iosetip(IOSRECL, XQRECL);
719iosetip(IOSNEXTREC, XNEXTREC);
720
721putiocall( call1(TYINT, "f_inqu", cpexpr(ioblkp) ));
722}
723
724
725
726LOCAL void
727dofmove(subname)
728char *subname;
729{
730register bigptr p;
731
732if( (p = V(IOSUNIT)) && ISINT(p->vtype) )
733 {
734 ioset(TYIOINT, XUNIT, cpexpr(p) );
735 putiocall( call1(TYINT, subname, cpexpr(ioblkp) ));
736 }
737else
738 err("bad unit in move statement");
739}
740
741
742
743LOCAL void
744ioset(type, offset, p)
745int type, offset;
746bigptr p;
747{
748register struct bigblock *q;
749
750q = cpexpr(ioblkp);
751q->vtype = type;
752q->b_addr.memoffset = fixtype( mkexpr(OPPLUS, q->b_addr.memoffset, MKICON(offset)) );
753puteq(q, p);
754}
755
756
757
758
759LOCAL void
760iosetc(offset, p)
761int offset;
762register bigptr p;
763{
764if(p == NULL)
765 ioset(TYADDR, offset, MKICON(0) );
766else if(p->vtype == TYCHAR)
767 ioset(TYADDR, offset, addrof(cpexpr(p) ));
768else
769 err("non-character control clause");
770}
771
772
773
774LOCAL void
775iosetip(i, offset)
776int i, offset;
777{
778register bigptr p;
779
780if((p = V(i))) {
781 if(p->tag==TADDR && ONEOF(p->vtype, M(TYLONG)|M(TYLOGICAL)) )
782 ioset(TYADDR, offset, addrof(cpexpr(p)) );
783 else
784 err1("impossible inquire parameter %s", ioc[i].iocname);
785} else
786 ioset(TYADDR, offset, MKICON(0) );
787}
788
789
790
791LOCAL void
792iosetlc(i, offp, offl)
793int i, offp, offl;
794{
795register bigptr p;
796if( (p = V(i)) && p->vtype==TYCHAR)
797 ioset(TYIOINT, offl, cpexpr(p->vleng) );
798iosetc(offp, p);
799}
Note: See TracBrowser for help on using the repository browser.