|
|
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.2 7/30/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: { char *byfile; ! 17: int i; ! 18: int exist; ! 19: unit *p; ! 20: char buf[256], *s; ! 21: long x_inode; ! 22: ! 23: elist = NO; ! 24: lfname = a->infile; ! 25: lunit = a->inunit; ! 26: external = YES; ! 27: p = NULL; ! 28: if(byfile=a->infile) ! 29: { ! 30: g_char(a->infile,a->infilen,buf); ! 31: if((x_inode=inode(buf))==-1) ! 32: { exist = NO; /* file doesn't exist */ ! 33: } ! 34: else ! 35: { exist = YES; /* file does exist */ ! 36: for(i=0;i<MXUNIT;i++) ! 37: if(units[i].ufd && (units[i].uinode==x_inode)) ! 38: { ! 39: p = &units[i]; ! 40: break; ! 41: } ! 42: } ! 43: } ! 44: else ! 45: { ! 46: if (not_legal(lunit)) ! 47: { exist = NO; /* unit doesn't exist */ ! 48: } ! 49: else ! 50: { exist = YES; ! 51: if (units[lunit].ufd) ! 52: { p= &units[lunit]; ! 53: lfname = p->ufnm; ! 54: } ! 55: } ! 56: } ! 57: if(a->inex) *a->inex = exist; ! 58: if(a->inopen) *a->inopen=(p!=NULL); ! 59: if(a->innum) *a->innum = byfile?(p?(p-units):-1):lunit; ! 60: if(a->innamed) *a->innamed= (byfile || (p && p->ufnm)); ! 61: if(a->inname) ! 62: { ! 63: if(byfile) s = buf; ! 64: else if(p && p->ufnm) s = p->ufnm; ! 65: else s=""; ! 66: b_char(s,a->inname,a->innamlen); ! 67: } ! 68: if(a->inacc) ! 69: { ! 70: if(!p) s = "unknown"; ! 71: else if(p->url) s = "direct"; ! 72: else s = "sequential"; ! 73: b_char(s,a->inacc,a->inacclen); ! 74: } ! 75: if(a->inseq) ! 76: { ! 77: if(!p) s = "unknown"; ! 78: else s = (p && !p->url)? "yes" : "no"; ! 79: b_char(s,a->inseq,a->inseqlen); ! 80: } ! 81: if(a->indir) ! 82: { ! 83: if(!p) s = "unknown"; ! 84: else s = (p && p->useek && p->url)? "yes" : "no"; ! 85: b_char(s,a->indir,a->indirlen); ! 86: } ! 87: if(a->inform) ! 88: { if(p) ! 89: { ! 90: #ifndef KOSHER ! 91: if(p->uprnt) s = "print"; /*** NOT STANDARD FORTRAN ***/ ! 92: else ! 93: #endif ! 94: s = p->ufmt?"formatted":"unformatted"; ! 95: } ! 96: else s = "unknown"; ! 97: b_char(s,a->inform,a->informlen); ! 98: } ! 99: if(a->infmt) ! 100: { ! 101: if (p) s= p->ufmt? "yes" : "no"; ! 102: else s= "unknown"; ! 103: b_char(s,a->infmt,a->infmtlen); ! 104: } ! 105: if(a->inunf) ! 106: { ! 107: if (p) s= p->ufmt? "no" : "yes"; ! 108: else s= "unknown"; ! 109: b_char(s,a->inunf,a->inunflen); ! 110: } ! 111: if(a->inrecl) *a->inrecl = p ? p->url : -1; ! 112: if(a->innrec) { ! 113: if(p && p->url) ! 114: *a->innrec = ((ftell(p->ufd) + p->url - 1)/p->url) + 1; ! 115: else ! 116: *a->innrec = -1; ! 117: } ! 118: if(a->inblank) ! 119: { ! 120: if( p && p->ufmt) ! 121: s = p->ublnk ? "zero" : "null" ; ! 122: else ! 123: s = "unknown"; ! 124: b_char(s,a->inblank,a->inblanklen); ! 125: } ! 126: return(OK); ! 127: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.