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