![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to io.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 41BSD / lib / libI77uc|
Return to io.c CVS log | Up to [CSRG BSD Unix] / 41BSD / lib / libI77uc |
1.1 root 1: /* Routines to generate code for I/O statements.
2: Some corrections and improvements due to David Wasley, U. C. Berkeley
3: Compile with -DKOSHER to force exact conformity with the ANSI std.
4: */
5:
6: #ifdef KOSHER
7: #define IOSRETURN 1 /* to force ANSI std return on iostat= */
8: #endif
9:
10: /* TEMPORARY */
11: #define TYIOINT TYLONG
12: #define SZIOINT SZLONG
13:
14: #include "defs"
15:
16:
17: LOCAL char ioroutine[XL+1];
18:
19: LOCAL int ioendlab;
20: LOCAL int ioerrlab;
21: LOCAL int iostest;
22: LOCAL int iosreturn;
23: LOCAL int jumplab;
24: LOCAL int skiplab;
25: LOCAL int ioformatted;
26:
27: #define UNFORMATTED 0
28: #define FORMATTED 1
29: #define LISTDIRECTED 2
30:
31: #define V(z) ioc[z].iocval
32:
33: #define IOALL 07777
34:
35: LOCAL struct Ioclist
36: {
37: char *iocname;
38: int iotype;
39: expptr iocval;
40: } ioc[ ] =
41: {
42: { "", 0 },
43: { "unit", IOALL },
44: { "fmt", M(IOREAD) | M(IOWRITE) },
45: { "err", IOALL },
46: #ifdef KOSHER
47: { "end", M(IOREAD) },
48: #else
49: { "end", M(IOREAD) | M(IOWRITE) },
50: #endif
51: { "iostat", IOALL },
52: { "rec", M(IOREAD) | M(IOWRITE) },
53: { "recl", M(IOOPEN) | M(IOINQUIRE) },
54: { "file", M(IOOPEN) | M(IOINQUIRE) },
55: { "status", M(IOOPEN) | M(IOCLOSE) },
56: { "access", M(IOOPEN) | M(IOINQUIRE) },
57: { "form", M(IOOPEN) | M(IOINQUIRE) },
58: { "blank", M(IOOPEN) | M(IOINQUIRE) },
59: { "exist", M(IOINQUIRE) },
60: { "opened", M(IOINQUIRE) },
61: { "number", M(IOINQUIRE) },
62: { "named", M(IOINQUIRE) },
63: { "name", M(IOINQUIRE) },
64: { "sequential", M(IOINQUIRE) },
65: { "direct", M(IOINQUIRE) },
66: { "formatted", M(IOINQUIRE) },
67: { "unformatted", M(IOINQUIRE) },
68: { "nextrec", M(IOINQUIRE) }
69: } ;
70:
71: #define NIOS (sizeof(ioc)/sizeof(struct Ioclist) - 1)
72: #define MAXIO SZFLAG + 10*SZIOINT + 15*SZADDR
73:
74: #define IOSUNIT 1
75: #define IOSFMT 2
76: #define IOSERR 3
77: #define IOSEND 4
78: #define IOSIOSTAT 5
79: #define IOSREC 6
80: #define IOSRECL 7
81: #define IOSFILE 8
82: #define IOSSTATUS 9
83: #define IOSACCESS 10
84: #define IOSFORM 11
85: #define IOSBLANK 12
86: #define IOSEXIST 13
87: #define IOSOPENED 14
88: #define IOSNUMBER 15
89: #define IOSNAMED 16
90: #define IOSNAME 17
91: #define IOSSEQUENTIAL 18
92: #define IOSDIRECT 19
93: #define IOSFORMATTED 20
94: #define IOSUNFORMATTED 21
95: #define IOSNEXTREC 22
96:
97: #define IOSTP V(IOSIOSTAT)
98: #define IOSRW (iostmt==IOREAD || iostmt==IOWRITE)
99:
100:
101: /* offsets in generated structures */
102:
103: #define SZFLAG SZIOINT
104:
105: /* offsets for external READ and WRITE statements */
106:
107: #define XERR 0
108: #define XUNIT SZFLAG
109: #define XEND SZFLAG + SZIOINT
110: #define XFMT 2*SZFLAG + SZIOINT
111: #define XREC 2*SZFLAG + SZIOINT + SZADDR
112:
113: /* offsets for internal READ and WRITE statements */
114:
115: #define XIERR 0
116: #define XIUNIT SZFLAG
117: #define XIEND SZFLAG + SZADDR
118: #define XIFMT 2*SZFLAG + SZADDR
119: #define XIRLEN 2*SZFLAG + 2*SZADDR
120: #define XIRNUM 2*SZFLAG + 2*SZADDR + SZIOINT
121: #define XIREC 2*SZFLAG + 2*SZADDR + 2*SZIOINT
122:
123: /* offsets for OPEN statements */
124:
125: #define XFNAME SZFLAG + SZIOINT
126: #define XFNAMELEN SZFLAG + SZIOINT + SZADDR
127: #define XSTATUS SZFLAG + 2*SZIOINT + SZADDR
128: #define XACCESS SZFLAG + 2*SZIOINT + 2*SZADDR
129: #define XFORMATTED SZFLAG + 2*SZIOINT + 3*SZADDR
130: #define XRECLEN SZFLAG + 2*SZIOINT + 4*SZADDR
131: #define XBLANK SZFLAG + 3*SZIOINT + 4*SZADDR
132:
133: /* offset for CLOSE statement */
134:
135: #define XCLSTATUS SZFLAG + SZIOINT
136:
137: /* offsets for INQUIRE statement */
138:
139: #define XFILE SZFLAG + SZIOINT
140: #define XFILELEN SZFLAG + SZIOINT + SZADDR
141: #define XEXISTS SZFLAG + 2*SZIOINT + SZADDR
142: #define XOPEN SZFLAG + 2*SZIOINT + 2*SZADDR
143: #define XNUMBER SZFLAG + 2*SZIOINT + 3*SZADDR
144: #define XNAMED SZFLAG + 2*SZIOINT + 4*SZADDR
145: #define XNAME SZFLAG + 2*SZIOINT + 5*SZADDR
146: #define XNAMELEN SZFLAG + 2*SZIOINT + 6*SZADDR
147: #define XQACCESS SZFLAG + 3*SZIOINT + 6*SZADDR
148: #define XQACCLEN SZFLAG + 3*SZIOINT + 7*SZADDR
149: #define XSEQ SZFLAG + 4*SZIOINT + 7*SZADDR
150: #define XSEQLEN SZFLAG + 4*SZIOINT + 8*SZADDR
151: #define XDIRECT SZFLAG + 5*SZIOINT + 8*SZADDR
152: #define XDIRLEN SZFLAG + 5*SZIOINT + 9*SZADDR
153: #define XFORM SZFLAG + 6*SZIOINT + 9*SZADDR
154: #define XFORMLEN SZFLAG + 6*SZIOINT + 10*SZADDR
155: #define XFMTED SZFLAG + 7*SZIOINT + 10*SZADDR
156: #define XFMTEDLEN SZFLAG + 7*SZIOINT + 11*SZADDR
157: #define XUNFMT SZFLAG + 8*SZIOINT + 11*SZADDR
158: #define XUNFMTLEN SZFLAG + 8*SZIOINT + 12*SZADDR
159: #define XQRECL SZFLAG + 9*SZIOINT + 12*SZADDR
160: #define XNEXTREC SZFLAG + 9*SZIOINT + 13*SZADDR
161: #define XQBLANK SZFLAG + 9*SZIOINT + 14*SZADDR
162: #define XQBLANKLEN SZFLAG + 9*SZIOINT + 15*SZADDR
163:
164: fmtstmt(lp)
165: register struct Labelblock *lp;
166: {
167: if(lp == NULL)
168: {
169: execerr("unlabeled format statement" , 0);
170: return(-1);
171: }
172: if(lp->labtype == LABUNKNOWN)
173: {
174: lp->labtype = LABFORMAT;
175: lp->labelno = newlabel();
176: }
177: else if(lp->labtype != LABFORMAT)
178: {
179: execerr("bad format number", 0);
180: return(-1);
181: }
182: return(lp->labelno);
183: }
184:
185:
186:
187: setfmt(lp)
188: struct Labelblock *lp;
189: {
190: ftnint n;
191: char *s, *lexline();
192:
193: s = lexline(&n);
194: preven(ALILONG);
195: prlabel(asmfile, lp->labelno);
196: putstr(asmfile, s, n);
197: flline();
198: }
199:
200:
201:
202: startioctl()
203: {
204: register int i;
205:
206: inioctl = YES;
207: nioctl = 0;
208: ioformatted = UNFORMATTED;
209: for(i = 1 ; i<=NIOS ; ++i)
210: V(i) = NULL;
211: }
212:
213:
214:
215: endioctl()
216: {
217: int i;
218: expptr p;
219:
220: inioctl = NO;
221: if(ioblkp == NULL)
222: ioblkp = autovar( (MAXIO+SZIOINT-1)/SZIOINT , TYIOINT, NULL);
223:
224: /* set up for error recovery */
225:
226: ioerrlab = ioendlab = jumplab = 0;
227: skiplab = iosreturn = NO;
228:
229: if(p = V(IOSEND))
230: if(ISICON(p))
231: ioendlab = mklabel(p->constblock.const.ci)->labelno;
232: else
233: err("bad end= clause");
234:
235: if(p = V(IOSERR))
236: if(ISICON(p))
237: ioerrlab = mklabel(p->constblock.const.ci)->labelno;
238: else
239: err("bad err= clause");
240:
241: if(IOSTP)
242: if(IOSTP->headblock.tag!=TADDR || ! ISINT(IOSTP->addrblock.vtype) )
243: {
244: err("iostat must be an integer variable");
245: frexpr(IOSTP);
246: IOSTP = NULL;
247: }
248: #ifdef IOSRETURN
249: else
250: iosreturn = YES;
251:
252: if(iosreturn && IOSRW && !(ioerrlab && ioendlab) )
253: {
254: jumplab = newlabel();
255: iostest = OPEQ;
256: if(ioerrlab || ioendlab) skiplab = YES;
257: }
258: else if(ioerrlab && !ioendlab)
259:
260: #else
261: if(ioerrlab && !ioendlab)
262: #endif
263: {
264: jumplab = ioerrlab;
265: iostest = IOSRW ? OPLE : OPEQ;
266: }
267: else if(!ioerrlab && ioendlab)
268: {
269: jumplab = ioendlab;
270: iostest = OPGE;
271: }
272: else if(ioerrlab && ioendlab)
273: {
274: iostest = OPEQ;
275: if(ioerrlab == ioendlab)
276: jumplab = ioerrlab;
277: else
278: {
279: if(!IOSTP) IOSTP = mktemp(TYINT, NULL);
280: jumplab = newlabel();
281: skiplab = YES;
282: }
283: }
284: /*else if(IOSTP) /* the standard requires this return! */
285: /* {
286: /* iosreturn = YES;
287: /* if(iostmt==IOREAD || iostmt==IOWRITE)
288: /* {
289: /* jumplab = newlabel();
290: /* iostest = OPEQ;
291: /* }
292: /* }
293: */
294:
295:
296: ioset(TYIOINT, XERR, ICON(ioerrlab!=0 || iosreturn) );
297:
298: switch(iostmt)
299: {
300: case IOOPEN:
301: dofopen(); break;
302:
303: case IOCLOSE:
304: dofclose(); break;
305:
306: case IOINQUIRE:
307: dofinquire(); break;
308:
309: case IOBACKSPACE:
310: dofmove("f_back"); break;
311:
312: case IOREWIND:
313: dofmove("f_rew"); break;
314:
315: case IOENDFILE:
316: dofmove("f_end"); break;
317:
318: case IOREAD:
319: case IOWRITE:
320: startrw(); break;
321:
322: default:
323: fatali("impossible iostmt %d", iostmt);
324: }
325: for(i = 1 ; i<=NIOS ; ++i)
326: if(i!=IOSIOSTAT && V(i)!=NULL)
327: frexpr(V(i));
328: }
329:
330:
331:
332: iocname()
333: {
334: register int i;
335: int found, mask;
336:
337: found = 0;
338: mask = M(iostmt);
339: for(i = 1 ; i <= NIOS ; ++i)
340: if(toklen==strlen(ioc[i].iocname) && eqn(toklen, token, ioc[i].iocname))
341: if(ioc[i].iotype & mask)
342: return(i);
343: else found = i;
344: if(found)
345: errstr("invalid control %s for statement", ioc[found].iocname);
346: else
347: errstr("unknown iocontrol %s", varstr(toklen, token) );
348: return(IOSBAD);
349: }
350:
351:
352: ioclause(n, p)
353: register int n;
354: register expptr p;
355: {
356: struct Ioclist *iocp;
357:
358: ++nioctl;
359: if(n == IOSBAD)
360: return;
361: if(n == IOSPOSITIONAL)
362: {
363: if(nioctl > IOSFMT)
364: {
365: err("illegal positional iocontrol");
366: return;
367: }
368: n = nioctl;
369: }
370:
371: if(p == NULL)
372: {
373: if(n == IOSUNIT)
374: p = (iostmt==IOREAD ? IOSTDIN : IOSTDOUT);
375: else if(n != IOSFMT)
376: {
377: err("illegal * iocontrol");
378: return;
379: }
380: }
381: if(n == IOSFMT)
382: ioformatted = (p==NULL ? LISTDIRECTED : FORMATTED);
383:
384: iocp = & ioc[n];
385: if(iocp->iocval == NULL)
386: {
387: if(n!=IOSFMT && ( n!=IOSUNIT || (p!=NULL && p->headblock.vtype!=TYCHAR) ) )
388: p = fixtype(p);
389: iocp->iocval = p;
390: }
391: else
392: errstr("iocontrol %s repeated", iocp->iocname);
393: }
394:
395: /* io list item */
396:
397: doio(list)
398: chainp list;
399: {
400: struct Exprblock *call0();
401: doiolist(list);
402: ioroutine[0] = 'e';
403: putiocall( call0(TYINT, ioroutine) );
404: }
405:
406:
407:
408:
409:
410: LOCAL doiolist(p0)
411: chainp p0;
412: {
413: chainp p;
414: register tagptr q;
415: register expptr qe;
416: register struct Nameblock *qn;
417: struct Addrblock *tp, *mkscalar();
418: int range;
419:
420: for (p = p0 ; p ; p = p->nextp)
421: {
422: q = p->datap;
423: if(q->headblock.tag == TIMPLDO)
424: {
425: exdo(range=newlabel(), q->impldoblock.varnp);
426: doiolist(q->impldoblock.datalist);
427: enddo(range);
428: free(q);
429: }
430: else {
431: if(q->headblock.tag==TPRIM && q->primblock.argsp==NULL
432: && q->primblock.namep->vdim!=NULL)
433: {
434: vardcl(qn = q->primblock.namep);
435: if(qn->vdim->nelt)
436: putio( fixtype(cpexpr(qn->vdim->nelt)),
437: mkscalar(qn) );
438: else
439: err("attempt to i/o array of unknown size");
440: }
441: else if(q->headblock.tag==TPRIM && q->primblock.argsp==NULL &&
442: (qe = memversion(q->primblock.namep)) )
443: putio(ICON(1),qe);
444: else if( (qe = fixtype(cpexpr(q)))->headblock.tag==TADDR)
445: putio(ICON(1), qe);
446: else if(qe->headblock.vtype != TYERROR)
447: {
448: if(iostmt == IOWRITE)
449: {
450: tp = mktemp(qe->headblock.vtype, qe->headblock.vleng);
451: puteq( cpexpr(tp), qe);
452: putio(ICON(1), tp);
453: }
454: else
455: err("non-left side in READ list");
456: }
457: frexpr(q);
458: }
459: }
460: frchain( &p0 );
461: }
462:
463:
464:
465:
466:
467: LOCAL putio(nelt, addr)
468: expptr nelt;
469: register expptr addr;
470: {
471: int type;
472: register struct Exprblock *q;
473:
474: type = addr->headblock.vtype;
475: if(ioformatted!=LISTDIRECTED && ISCOMPLEX(type) )
476: {
477: nelt = mkexpr(OPSTAR, ICON(2), nelt);
478: type -= (TYCOMPLEX-TYREAL);
479: }
480:
481: /* pass a length with every item. for noncharacter data, fake one */
482: if(type != TYCHAR)
483: {
484: if( ISCONST(addr) )
485: addr = putconst(addr);
486: addr->headblock.vtype = TYCHAR;
487: addr->headblock.vleng = ICON( typesize[type] );
488: }
489:
490: nelt = fixtype( mkconv(TYLENG,nelt) );
491: if(ioformatted == LISTDIRECTED)
492: q = call3(TYINT, "do_lio", mkconv(TYLONG, ICON(type)), nelt, addr);
493: else
494: q = call2(TYINT, (ioformatted==FORMATTED ? "do_fio" : "do_uio"),
495: nelt, addr);
496: putiocall(q);
497: }
498:
499:
500:
501:
502: endio()
503: {
504: if(skiplab)
505: {
506: putlabel(jumplab);
507: if(ioendlab) putif( mkexpr(OPGE, cpexpr(IOSTP), ICON(0)), ioendlab);
508: if(ioerrlab) putif( mkexpr(OPLE, cpexpr(IOSTP), ICON(0)), ioerrlab);
509: }
510: else if(iosreturn && jumplab)
511: putlabel(jumplab);
512: if(IOSTP)
513: frexpr(IOSTP);
514: }
515:
516:
517:
518: LOCAL putiocall(q)
519: register struct Exprblock *q;
520: {
521: if(IOSTP)
522: {
523: q->vtype = TYINT;
524: q = fixexpr( mkexpr(OPASSIGN, cpexpr(IOSTP), q));
525: }
526:
527: if(jumplab)
528: putif( mkexpr(iostest, q, ICON(0) ), jumplab);
529: else
530: putexpr(q);
531: }
532:
533:
534: startrw()
535: {
536: register expptr p;
537: register struct Nameblock *np;
538: register struct Addrblock *unitp, *nump;
539: struct Constblock *mkaddcon();
540: int k, fmtoff;
541: int intfile, sequential;
542:
543: intfile = NO;
544: if(p = V(IOSUNIT))
545: {
546: if( ISINT(p->headblock.vtype) )
547: ioset(TYIOINT, XUNIT, cpexpr(p) );
548: else if(p->headblock.vtype == TYCHAR)
549: {
550: intfile = YES;
551: if(p->headblock.tag==TPRIM && p->primblock.argsp==NULL &&
552: (np = p->primblock.namep)->vdim!=NULL)
553: {
554: vardcl(np);
555: if(np->vdim->nelt)
556: nump = cpexpr(np->vdim->nelt);
557: else
558: {
559: err("attempt to use internal unit array of unknown size");
560: nump = ICON(1);
561: }
562: unitp = mkscalar(np);
563: }
564: else {
565: nump = ICON(1);
566: unitp = fixtype(cpexpr(p));
567: }
568: ioset(TYIOINT, XIRNUM, nump);
569: ioset(TYIOINT, XIRLEN, cpexpr(unitp->vleng) );
570: ioset(TYADDR, XIUNIT, addrof(unitp) );
571: }
572: }
573: else
574: err("bad unit specifier");
575:
576: sequential = YES;
577: if(p = V(IOSREC))
578: if( ISINT(p->headblock.vtype) )
579: {
580: ioset(TYIOINT, (intfile ? XIREC : XREC), cpexpr(p) );
581: sequential = NO;
582: }
583: else
584: err("bad REC= clause");
585:
586: ioset(TYIOINT, (intfile ? XIEND : XEND), ICON(ioendlab!=0 || iosreturn) );
587:
588: fmtoff = (intfile ? XIFMT : XFMT);
589:
590: if(p = V(IOSFMT))
591: {
592: if(p->headblock.tag==TPRIM && p->primblock.argsp==NULL)
593: {
594: vardcl(np = p->primblock.namep);
595: if(np->vdim)
596: {
597: ioset(TYADDR, fmtoff, addrof(mkscalar(np)) );
598: goto endfmt;
599: }
600: if( ISINT(np->vtype) )
601: {
602: ioset(TYADDR, fmtoff, p);
603: goto endfmt;
604: }
605: }
606: p = V(IOSFMT) = fixtype(p);
607: if(p->headblock.vtype == TYCHAR)
608: ioset(TYADDR, fmtoff, addrof(cpexpr(p)) );
609: else if( ISICON(p) )
610: {
611: if( (k = fmtstmt( mklabel(p->constblock.const.ci) )) > 0 )
612: ioset(TYADDR, fmtoff, mkaddcon(k) );
613: else
614: ioformatted = UNFORMATTED;
615: }
616: else {
617: err("bad format descriptor");
618: ioformatted = UNFORMATTED;
619: }
620: }
621: else
622: ioset(TYADDR, fmtoff, ICON(0) );
623:
624: endfmt:
625: if(intfile && ioformatted==UNFORMATTED)
626: err("unformatted internal I/O not allowed");
627: if(!sequential && ioformatted==LISTDIRECTED)
628: err("direct list-directed I/O not allowed");
629:
630: ioroutine[0] = 's';
631: ioroutine[1] = '_';
632: ioroutine[2] = (iostmt==IOREAD ? 'r' : 'w');
633: ioroutine[3] = (sequential ? 's' : 'd');
634: ioroutine[4] = "ufl" [ioformatted];
635: ioroutine[5] = (intfile ? 'i' : 'e');
636: ioroutine[6] = '\0';
637: putiocall( call1(TYINT, ioroutine, cpexpr(ioblkp) ));
638: }
639:
640:
641:
642: LOCAL dofopen()
643: {
644: register expptr p;
645:
646: if( (p = V(IOSUNIT)) && ISINT(p->headblock.vtype) )
647: ioset(TYIOINT, XUNIT, cpexpr(p) );
648: else
649: err("bad unit in open");
650: if( (p = V(IOSFILE)) )
651: if(p->headblock.vtype == TYCHAR)
652: ioset(TYIOINT, XFNAMELEN, cpexpr(p->headblock.vleng) );
653: else
654: err("bad file in open");
655:
656: iosetc(XFNAME, p);
657:
658: if(p = V(IOSRECL))
659: if( ISINT(p->headblock.vtype) )
660: ioset(TYIOINT, XRECLEN, cpexpr(p) );
661: else
662: err("bad recl");
663: else
664: ioset(TYIOINT, XRECLEN, ICON(0) );
665:
666: iosetc(XSTATUS, V(IOSSTATUS));
667: iosetc(XACCESS, V(IOSACCESS));
668: iosetc(XFORMATTED, V(IOSFORM));
669: iosetc(XBLANK, V(IOSBLANK));
670:
671: putiocall( call1(TYINT, "f_open", cpexpr(ioblkp) ));
672: }
673:
674:
675: LOCAL dofclose()
676: {
677: register expptr p;
678:
679: if( (p = V(IOSUNIT)) && ISINT(p->headblock.vtype) )
680: {
681: ioset(TYIOINT, XUNIT, cpexpr(p) );
682: iosetc(XCLSTATUS, V(IOSSTATUS));
683: putiocall( call1(TYINT, "f_clos", cpexpr(ioblkp)) );
684: }
685: else
686: err("bad unit in close statement");
687: }
688:
689:
690: LOCAL dofinquire()
691: {
692: register expptr p;
693: if(p = V(IOSUNIT))
694: {
695: if( V(IOSFILE) )
696: err("inquire by unit or by file, not both");
697: ioset(TYIOINT, XUNIT, cpexpr(p) );
698: }
699: else if( ! V(IOSFILE) )
700: err("must inquire by unit or by file");
701: iosetlc(IOSFILE, XFILE, XFILELEN);
702: iosetip(IOSEXISTS, XEXISTS);
703: iosetip(IOSOPENED, XOPEN);
704: iosetip(IOSNUMBER, XNUMBER);
705: iosetip(IOSNAMED, XNAMED);
706: iosetlc(IOSNAME, XNAME, XNAMELEN);
707: iosetlc(IOSACCESS, XQACCESS, XQACCLEN);
708: iosetlc(IOSSEQUENTIAL, XSEQ, XSEQLEN);
709: iosetlc(IOSDIRECT, XDIRECT, XDIRLEN);
710: iosetlc(IOSFORM, XFORM, XFORMLEN);
711: iosetlc(IOSFORMATTED, XFMTED, XFMTEDLEN);
712: iosetlc(IOSUNFORMATTED, XUNFMT, XUNFMTLEN);
713: iosetip(IOSRECL, XQRECL);
714: iosetip(IOSNEXTREC, XNEXTREC);
715: iosetlc(IOSBLANK, XQBLANK, XQBLANKLEN);
716:
717: putiocall( call1(TYINT, "f_inqu", cpexpr(ioblkp) ));
718: }
719:
720:
721:
722: LOCAL dofmove(subname)
723: char *subname;
724: {
725: register expptr p;
726:
727: if( (p = V(IOSUNIT)) && ISINT(p->headblock.vtype) )
728: {
729: ioset(TYIOINT, XUNIT, cpexpr(p) );
730: putiocall( call1(TYINT, subname, cpexpr(ioblkp) ));
731: }
732: else
733: err("bad unit in I/O motion statement");
734: }
735:
736:
737:
738: LOCAL ioset(type, offset, p)
739: int type, offset;
740: expptr p;
741: {
742: register struct Addrblock *q;
743:
744: q = cpexpr(ioblkp);
745: q->vtype = type;
746: q->memoffset = fixtype( mkexpr(OPPLUS, q->memoffset, ICON(offset)) );
747: puteq(q, p);
748: }
749:
750:
751:
752:
753: LOCAL iosetc(offset, p)
754: int offset;
755: register expptr p;
756: {
757: if(p == NULL)
758: ioset(TYADDR, offset, ICON(0) );
759: else if(p->headblock.vtype == TYCHAR)
760: ioset(TYADDR, offset, addrof(cpexpr(p) ));
761: else
762: err("non-character control clause");
763: }
764:
765:
766:
767: LOCAL iosetip(i, offset)
768: int i, offset;
769: {
770: register expptr p;
771:
772: if(p = V(i))
773: if(p->headblock.tag==TADDR &&
774: ONEOF(p->addrblock.vtype, M(TYLONG)|M(TYLOGICAL)) )
775: ioset(TYADDR, offset, addrof(cpexpr(p)) );
776: else
777: errstr("impossible inquire parameter %s", ioc[i].iocname);
778: else
779: ioset(TYADDR, offset, ICON(0) );
780: }
781:
782:
783:
784: LOCAL iosetlc(i, offp, offl)
785: int i, offp, offl;
786: {
787: register expptr p;
788: if( (p = V(i)) && p->headblock.vtype==TYCHAR)
789: ioset(TYIOINT, offl, cpexpr(p->headblock.vleng) );
790: iosetc(offp, p);
791: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.