|
|
1.1 ! root 1: /* ! 2: * open.c - f77 file open routines ! 3: */ ! 4: ! 5: #include <sys/types.h> ! 6: #include <sys/stat.h> ! 7: #include <errno.h> ! 8: #include "fio.h" ! 9: ! 10: #define SCRATCH (st=='s') ! 11: #define NEW (st=='n') ! 12: #define OLD (st=='o') ! 13: #define OPEN (b->ufd) ! 14: #define FROM_OPEN "\1" /* for use in f_clos() */ ! 15: ! 16: extern char *tmplate; ! 17: extern char *fortfile; ! 18: ! 19: f_open(a) olist *a; ! 20: { unit *b; ! 21: int n,exists; ! 22: char buf[256],st; ! 23: cllist x; ! 24: ! 25: lfname = NULL; ! 26: elist = NO; ! 27: external = YES; /* for err */ ! 28: errflag = a->oerr; ! 29: lunit = a->ounit; ! 30: if(not_legal(lunit)) err(errflag,101,"open") ! 31: b= &units[lunit]; ! 32: if(a->osta) st = lcase(*a->osta); ! 33: else st = 'u'; ! 34: if(SCRATCH) ! 35: { strcpy(buf,tmplate); ! 36: mktemp(buf); ! 37: } ! 38: else if(a->ofnm) g_char(a->ofnm,a->ofnmlen,buf); ! 39: else sprintf(buf,fortfile,lunit); ! 40: lfname = &buf[0]; ! 41: if(OPEN) ! 42: { ! 43: if(!a->ofnm || inode(buf)==b->uinode) ! 44: { ! 45: if(a->oblnk) b->ublnk= (lcase(*a->oblnk)== 'z'); ! 46: #ifndef KOSHER ! 47: if(a->ofm && b->ufmt) b->uprnt = (lcase(*a->ofm)== 'p'); ! 48: #endif ! 49: return(OK); ! 50: } ! 51: x.cunit=lunit; ! 52: x.csta=FROM_OPEN; ! 53: x.cerr=errflag; ! 54: if(n=f_clos(&x)) return(n); ! 55: } ! 56: exists = (access(buf,0)==NULL); ! 57: if(!exists && OLD) err(errflag,118,"open"); ! 58: if( exists && NEW) err(errflag,117,"open"); ! 59: if(isdev(buf)) ! 60: { if((b->ufd = fopen(buf,"r")) != NULL) b->uwrt = NO; ! 61: else err(errflag,errno,buf) ! 62: } ! 63: else ! 64: { if((b->ufd = fopen(buf, "a")) != NULL) b->uwrt = YES; ! 65: else if((b->ufd = fopen(buf, "r")) != NULL) ! 66: { fseek(b->ufd, 0L, 2); ! 67: b->uwrt = NO; ! 68: } ! 69: else err(errflag, errno, buf) ! 70: } ! 71: if((b->uinode=finode(b->ufd))==-1) err(errflag,108,"open") ! 72: b->ufnm = (char *) calloc(strlen(buf)+1,sizeof(char)); ! 73: if(b->ufnm==NULL) err(errflag,113,"open") ! 74: strcpy(b->ufnm,buf); ! 75: b->uscrtch = SCRATCH; ! 76: b->uend = NO; ! 77: b->useek = canseek(b->ufd); ! 78: b->url = a->orl; ! 79: b->ublnk = (a->oblnk && (lcase(*a->oblnk)=='z')); ! 80: if (a->ofm) ! 81: { ! 82: switch(lcase(*a->ofm)) ! 83: { ! 84: case 'f': ! 85: b->ufmt = YES; ! 86: b->uprnt = NO; ! 87: break; ! 88: #ifndef KOSHER ! 89: case 'p': /* print file *** NOT STANDARD FORTRAN ***/ ! 90: b->ufmt = YES; ! 91: b->uprnt = YES; ! 92: break; ! 93: #endif ! 94: case 'u': ! 95: b->ufmt = NO; ! 96: b->uprnt = NO; ! 97: break; ! 98: default: ! 99: err(errflag,121,"open form=") ! 100: } ! 101: } ! 102: else /* not specified */ ! 103: { b->ufmt = (b->url==0); ! 104: b->uprnt = NO; ! 105: } ! 106: if(b->url && b->useek) rewind(b->ufd); ! 107: return(OK); ! 108: } ! 109: ! 110: fk_open(rd,seq,fmt,n) ftnint n; ! 111: { char nbuf[10]; ! 112: olist a; ! 113: sprintf(nbuf, fortfile, (int)n); ! 114: a.oerr=errflag; ! 115: a.ounit=n; ! 116: a.ofnm=nbuf; ! 117: a.ofnmlen=strlen(nbuf); ! 118: a.osta=NULL; ! 119: a.oacc= seq==SEQ?"s":"d"; ! 120: a.ofm = fmt==FMT?"f":"u"; ! 121: a.orl = seq==DIR?1:0; ! 122: a.oblnk=NULL; ! 123: return(f_open(&a)); ! 124: } ! 125: ! 126: isdev(s) char *s; ! 127: { struct stat x; ! 128: int j; ! 129: if(stat(s, &x) == -1) return(NO); ! 130: if((j = (x.st_mode&S_IFMT)) == S_IFREG || j == S_IFDIR) return(NO); ! 131: else return(YES); ! 132: } ! 133:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.