1 /*-
2 * Copyright (c) 1980 The Regents of the University of California.
3 * All rights reserved.
4 *
5 * %sccs.include.proprietary.c%
6 */
7
8 #ifndef lint
9 static char sccsid[] = "@(#)inquire.c 5.3 (Berkeley) 04/12/91";
10 #endif /* not lint */
11
12 /*
13 * inquire.c - f77 i/o inquire statement routine
14 */
15
16 #include "fio.h"
17
f_inqu(a)18 f_inqu(a) inlist *a;
19 { char *byfile;
20 int i;
21 int exist;
22 unit *p;
23 char buf[256], *s;
24 long x_inode;
25
26 elist = NO;
27 lfname = a->infile;
28 lunit = a->inunit;
29 external = YES;
30 p = NULL;
31 if(byfile=a->infile)
32 {
33 g_char(a->infile,a->infilen,buf);
34 if((x_inode=inode(buf))==-1)
35 { exist = NO; /* file doesn't exist */
36 }
37 else
38 { exist = YES; /* file does exist */
39 for(i=0;i<MXUNIT;i++)
40 if(units[i].ufd && (units[i].uinode==x_inode))
41 {
42 p = &units[i];
43 break;
44 }
45 }
46 }
47 else
48 {
49 if (not_legal(lunit))
50 { exist = NO; /* unit doesn't exist */
51 }
52 else
53 { exist = YES;
54 if (units[lunit].ufd)
55 { p= &units[lunit];
56 lfname = p->ufnm;
57 }
58 }
59 }
60 if(a->inex) *a->inex = exist;
61 if(a->inopen) *a->inopen=(p!=NULL);
62 if(a->innum) *a->innum = byfile?(p?(p-units):-1):lunit;
63 if(a->innamed) *a->innamed= (byfile || (p && p->ufnm));
64 if(a->inname)
65 {
66 if(byfile) s = buf;
67 else if(p && p->ufnm) s = p->ufnm;
68 else s="";
69 b_char(s,a->inname,a->innamlen);
70 }
71 if(a->inacc)
72 {
73 if(!p) s = "unknown";
74 else if(p->url) s = "direct";
75 else s = "sequential";
76 b_char(s,a->inacc,a->inacclen);
77 }
78 if(a->inseq)
79 {
80 if(!p) s = "unknown";
81 else s = (p && !p->url)? "yes" : "no";
82 b_char(s,a->inseq,a->inseqlen);
83 }
84 if(a->indir)
85 {
86 if(!p) s = "unknown";
87 else s = (p && p->useek && p->url)? "yes" : "no";
88 b_char(s,a->indir,a->indirlen);
89 }
90 if(a->inform)
91 { if(p)
92 {
93 #ifndef KOSHER
94 if(p->uprnt) s = "print"; /*** NOT STANDARD FORTRAN ***/
95 else
96 #endif
97 s = p->ufmt?"formatted":"unformatted";
98 }
99 else s = "unknown";
100 b_char(s,a->inform,a->informlen);
101 }
102 if(a->infmt)
103 {
104 if (p) s= p->ufmt? "yes" : "no";
105 else s= "unknown";
106 b_char(s,a->infmt,a->infmtlen);
107 }
108 if(a->inunf)
109 {
110 if (p) s= p->ufmt? "no" : "yes";
111 else s= "unknown";
112 b_char(s,a->inunf,a->inunflen);
113 }
114 if(a->inrecl) *a->inrecl = p ? p->url : -1;
115 if(a->innrec) {
116 if(p && p->url)
117 *a->innrec = ((ftell(p->ufd) + p->url - 1)/p->url) + 1;
118 else
119 *a->innrec = -1;
120 }
121 if(a->inblank)
122 {
123 if( p && p->ufmt)
124 s = p->ublnk ? "zero" : "null" ;
125 else
126 s = "unknown";
127 b_char(s,a->inblank,a->inblanklen);
128 }
129 return(OK);
130 }
131