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