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 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