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