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