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