|
|
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.1 6/7/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: { flag byfile; ! 17: int i; ! 18: unit *p; ! 19: char buf[256], *s; ! 20: long x_inode; ! 21: if(a->infile!=NULL) ! 22: { byfile=1; ! 23: g_char(a->infile,a->infilen,buf); ! 24: x_inode=inode(buf); ! 25: for(i=0,p=NULL;i<MXUNIT;i++) ! 26: if(units[i].uinode==x_inode && units[i].ufd!=NULL) ! 27: p = &units[i]; ! 28: } ! 29: else ! 30: { ! 31: byfile=0; ! 32: if(a->inunit<MXUNIT && a->inunit>=0) ! 33: { ! 34: p= &units[a->inunit]; ! 35: } ! 36: else ! 37: { ! 38: p=NULL; ! 39: } ! 40: } ! 41: if(a->inex!=NULL) ! 42: if(byfile && x_inode>0 || !byfile && p!=NULL) ! 43: *a->inex=1; ! 44: else *a->inex=0; ! 45: if(a->inopen!=NULL) ! 46: if(byfile) *a->inopen=(p!=NULL); ! 47: else *a->inopen=(p!=NULL && p->ufd!=NULL); ! 48: if(a->innum) *a->innum= (p?(p-units):-1); ! 49: if(a->innamed) *a->innamed= (byfile || (p && p->ufnm)); ! 50: if(a->inname) ! 51: { ! 52: if(byfile) s = buf; ! 53: else if(p && p->ufnm) s = p->ufnm; ! 54: else s=""; ! 55: b_char(s,a->inname,a->innamlen); ! 56: } ! 57: if(a->inacc && p) ! 58: { ! 59: if(p->url) s = "DIRECT"; ! 60: else s = "SEQUENTIAL"; ! 61: b_char(s,a->inacc,a->inacclen); ! 62: } ! 63: if(a->inseq) ! 64: { ! 65: s= ((byfile && !p) || (p && !p->url))? "YES" : "NO"; ! 66: b_char(s,a->inseq,a->inseqlen); ! 67: } ! 68: if(a->indir) ! 69: { ! 70: s= ((byfile && !p) || (p && p->useek && p->url))? "YES" : "NO"; ! 71: b_char(s,a->indir,a->indirlen); ! 72: } ! 73: if(a->inform) ! 74: { if(p) ! 75: { ! 76: #ifndef KOSHER ! 77: if(p->uprnt) s = "PRINT"; /*** NOT STANDARD FORTRAN ***/ ! 78: else ! 79: #endif ! 80: s = p->ufmt?"FORMATTED":"UNFORMATTED"; ! 81: } ! 82: else s = "UNKNOWN"; ! 83: b_char(s,a->inform,a->informlen); ! 84: } ! 85: if(a->infmt) ! 86: { ! 87: if (p) s= p->ufmt? "YES" : "NO"; ! 88: else s= "unknown"; ! 89: b_char(s,a->infmt,a->infmtlen); ! 90: } ! 91: if(a->inunf) ! 92: { ! 93: if (p) s= p->ufmt? "NO" : "YES"; ! 94: else s= "UNKNOWN"; ! 95: b_char(s,a->inunf,a->inunflen); ! 96: } ! 97: if(a->inrecl && p) *a->inrecl=p->url; ! 98: if(a->innrec && p && p->url) ! 99: *a->innrec=((ftell(p->ufd) + p->url - 1)/p->url) + 1; ! 100: if(a->inblank && p && p->ufmt) ! 101: { ! 102: b_char(p->ublnk? "ZERO" : "NULL",a->inblank,a->inblanklen); ! 103: } ! 104: return(OK); ! 105: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.