|
|
1.1 ! root 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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.