int
f77inode (char *a, ino_t *inod)
{
struct stat x;
char uname[PATH_MAX];
if (a[3] == '$' && _I90_uppercase(a, uname) &&
(!strcmp (uname, "SYS$INPUT") || !strcmp (uname, "SYS$OUTPUT") ||
!strcmp (uname, "SYS$ERROR")))
return (0);
/* bug fix 12763 and 12983, add new parameter */
#ifdef SHLIB
if ((*_libI77_stat) (a, &x) < 0)
return (-1);
#else
if (stat (a, &x) < 0)
return (-1);
#endif
*inod = x.st_ino;
return (1);
}
f_inqu0_com (inlist *a, int *mask, int lock)
#endif
{
flag byfile;
flag sysfile = 0; /* set this flag if the file name is
* "SYS$*" */
int i;
char buf[PATH_MAX], *abuf;
int x = 0;
ino_t inod;
unit *ftnunit;
if (a->infile != NULL) {
char *flname;
flname = a->infile;
byfile = 1;
if (flname[3] == '$' && _I90_uppercase(flname, buf) &&
(!strcmp (buf, "SYS$INPUT") || !strcmp (buf, "SYS$OUTPUT")
|| !strcmp (buf, "SYS$ERROR")))
sysfile = 1;
if (a->indefaultfile) {
g_char (a->indefaultfile, a->indefaultfilelen, buf);
abuf = buf + strlen (buf);
} else
abuf = buf;
g_char (a->infile, a->infilen, abuf);
/* bug fix 12983 */
x = f77inode (buf, &inod);
if (x < 0) {
mkidxname (buf, buf);
x = f77inode (buf, &inod);
}
if (strlen (buf) > PATH_MAX) {
/* can't use err() with inquire since f77curunit is never defined
by a call to map_luno
err (a->inerr, 145, "inquire");
*/
if (a->inerr) {
return(errno=F_ERFNAME);
} else {
fprintf(stderr, "Error in INQUIRE: file name too long: %s\n", buf);
_cleanup ();
exit(F_ERFNAME);
}
}
ftnunit = NULL;
if (x < 0)
goto setvar;
for (i = 0; i < mxunit; i++) /* sjc #1963 11Dec 87 */
if (f77units[i].uinode == inod && f77units[i].uconn > 0) {
ftnunit = &f77units[i];
/*
while (lock && test_and_set( &ftnunit->lock_unit, 1L ))
;
*/
break;
}
} else {
byfile = 0;
ftnunit = map_luno (a->inunit);
/*
while (lock && test_and_set( &ftnunit->lock_unit, 1L ))
;
*/
}
setvar:
if (a->inex)
/* Fix BN 11327 .
* If the file name is SYS$* then the file always exists. The sysfile
* flag gets set above and hence when a user does and inquire with EXIST, then
* the exist variable will be set .
*
* ---ravi---1/16/92
*/
set_var (a->inex, *mask, INEX,
(byfile && x > 0 || !byfile && ftnunit != NULL || sysfile) ? 1 : 0);
if (a->inopen)
set_var (a->inopen, *mask, INOPEN, byfile ? (ftnunit != NULL) : (ftnunit && ftnunit->uconn > 0));
if (a->innum)
set_var (a->innum, *mask, INNUM, ftnunit ? ftnunit->luno : 0);
if (a->innamed)
set_var (a->innamed, *mask, INNAMED,
(byfile || ftnunit != NULL && ftnunit->ufnm != NULL) ? 1 : 0);
if (a->inname != NULL)
if (byfile)
b_char (buf, a->inname, a->innamlen);
else if (ftnunit != NULL && ftnunit->ufnm != NULL)
b_char (ftnunit->ufnm, a->inname, a->innamlen);
else
b_char ("", a->inname, a->innamlen);
if (a->inacc)
if (ftnunit && ftnunit->uconn > 0)
switch (ftnunit->uacc) {
case SEQUENTIAL:
b_char ("SEQUENTIAL", a->inacc, a->inacclen);
break;
case DIRECT:
b_char ("DIRECT", a->inacc, a->inacclen);
break;
case KEYED:
b_char ("KEYED", a->inacc, a->inacclen);
break;
default:
b_char ("UNKNOWN", a->inacc, a->inacclen);
}
else
b_char ("UNKNOWN", a->inacc, a->inacclen);
if (a->inseq != NULL)
if (ftnunit)
b_char ((ftnunit->uacc == SEQUENTIAL) ? "YES" : "NO",
a->inseq, a->inseqlen);
else
b_char ("UNKNOWN", a->inseq, a->inseqlen);
if (a->indir != NULL)
if (ftnunit)
b_char ((ftnunit->uacc == DIRECT) ? "YES" : "NO",
a->indir, a->indirlen);
else
b_char ("UNKNOWN", a->indir, a->indirlen);
if (a->infmt != NULL)
if (ftnunit)
if (!ftnunit->ufmt)
b_char ("UNFORMATTED", a->infmt, a->infmtlen);
else if (ftnunit->ufmt == 1)
b_char ("FORMATTED", a->infmt, a->infmtlen);
else
b_char ("BINARY", a->infmt, a->infmtlen);
else
b_char ("UNKNOWN", a->infmt, a->infmtlen);
if (a->inform != NULL)
if (ftnunit)
b_char (ftnunit->ufmt > 0 ? "YES" : "NO", a->inform, a->informlen);
else
b_char ("UNKNOWN", a->inform, a->informlen);
if (a->inunf)
if (ftnunit)
b_char (ftnunit->ufmt > 0 ? "NO" : "YES", a->inunf, a->inunflen);
else
b_char ("UNKNOWN", a->inunf, a->inunflen);
if (a->inrecl)
set_var (a->inrecl, *mask, INRECL,
(int) (ftnunit ? (ftnunit->ufmt || f77vms_flag_[OLD_RL] ?
ftnunit->url : ftnunit->url / sizeof (int)) : 0));
if (a->innrec) {
/* CALVIN: need to determine if a->innrec points to a *4 or a *8 */
if (ftnunit && (ftnunit->uacc == DIRECT) && (ftnunit->ufmt == 0)) {
set_var (a->innrec, *mask, INNREC,
(ftnunit && ftnunit->uacc == DIRECT && ftnunit->url) ? ftnunit->uirec + 1 : 0);
} else {
set_var (a->innrec, *mask, INNREC,
(ftnunit && ftnunit->uacc == DIRECT && ftnunit->url) ? ftell (ftnunit->ufd) / ftnunit->url + 1 : 0);
}
}
if (a->inblank)
if (ftnunit && ftnunit->ufmt > 0)
b_char (ftnunit->ublnk ? "ZERO" : "NULL", a->inblank, a->inblanklen);
else
b_char ("UNKNOWN", a->inblank, a->inblanklen);
if (a->incc)
if (ftnunit && ftnunit->ufmt > 0)
switch (ftnunit->ucc) {
case CC_FORTRAN:
b_char ("FORTRAN", a->incc, a->incclen);
break;
case CC_LIST:
b_char ("LIST", a->incc, a->incclen);
break;
case CC_NONE:
b_char ("NONE", a->incc, a->incclen);
break;
default:
b_char ("UNKNOWN", a->incc, a->incclen);
}
else
b_char ("UNKNOWN", a->incc, a->incclen);
if (a->inkeyed)
if (ftnunit)
b_char (ftnunit->uacc == KEYED ? "YES" : "NO", a->inkeyed, a->inkeyedlen);
else
b_char ("UNKNOWN", a->inkeyed, a->inkeyedlen);
if (a->inorg)
if (ftnunit)
switch (ftnunit->uacc) {
case SEQUENTIAL:
b_char ("SEQUNTIAL", a->inorg, a->inorglen);
break;
case DIRECT:
b_char ("RELATIVE", a->inorg, a->inorglen);
break;
case KEYED:
b_char ("INDEXED", a->inorg, a->inorglen);
break;
default:
b_char ("UNKNOWN", a->inorg, a->inorglen);
}
else
b_char ("UNKNOWN", a->inorg, a->inorglen);
if (a->inrecordtype)
if (ftnunit)
switch (ftnunit->uacc) {
case SEQUENTIAL:
b_char (ftnunit->ufmt == 1 ? "STREAM_LF" : "VARIABLE",
a->inrecordtype, a->inrecordtypelen);
break;
case DIRECT:
case KEYED:
b_char ("FIXED", a->inrecordtype, a->inrecordtypelen);
break;
default:
b_char ("UNKNOWN", a->inrecordtype, a->inrecordtypelen);
}
else
b_char ("UNKNOWN", a->inrecordtype, a->inrecordtypelen);
/*
if (ftnunit) {
ftnunit->lock_unit = 0;
}
*/
return (0);
}