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