![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to open.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / lib / libI77|
Return to open.c CVS log | Up to [CSRG BSD Unix] / 43BSDReno / lib / libI77 |
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: * @(#)open.c 5.3 10/24/88 ! 7: */ ! 8: ! 9: /* ! 10: * open.c - f77 file open and I/O library initialization routines ! 11: */ ! 12: ! 13: #include <sys/types.h> ! 14: #include <sys/stat.h> ! 15: #include <errno.h> ! 16: #include "fio.h" ! 17: ! 18: #define SCRATCH (st=='s') ! 19: #define NEW (st=='n') ! 20: #define OLD (st=='o') ! 21: #define OPEN (b->ufd) ! 22: #define FROM_OPEN "\2" /* for use in f_clos() */ ! 23: #define BUF_LEN 256 ! 24: ! 25: LOCAL char *tmplate = "tmp.FXXXXXX"; /* scratch file template */ ! 26: LOCAL char *fortfile = "fort.%d"; /* default file template */ ! 27: ! 28: char *getenv(); ! 29: ! 30: f_open(a) olist *a; ! 31: { unit *b; ! 32: struct stat sbuf; ! 33: int n,exists; ! 34: char buf[BUF_LEN], env_name[BUF_LEN]; ! 35: char *env_val, *p1, *p2, ch, st; ! 36: cllist x; ! 37: ! 38: lfname = NULL; ! 39: elist = NO; ! 40: external = YES; /* for err */ ! 41: errflag = a->oerr; ! 42: lunit = a->ounit; ! 43: if(not_legal(lunit)) err(errflag,F_ERUNIT,"open") ! 44: b= &units[lunit]; ! 45: if(a->osta) st = lcase(*a->osta); ! 46: else st = 'u'; ! 47: if(SCRATCH) ! 48: { strcpy(buf,tmplate); ! 49: /* make a new temp file name, err if mktemp fails */ ! 50: if( strcmp( mktemp(buf), "/" ) == 0 ) ! 51: err(errflag, F_ERSYS, "open") ! 52: } ! 53: else ! 54: { ! 55: if(a->ofnm) g_char(a->ofnm,a->ofnmlen,buf); ! 56: else sprintf(buf,fortfile,lunit); ! 57: /* check if overriding file name via environment variable ! 58: * first copy tail of name - delete periods as Bourne Shell ! 59: * croaks if any periods in name ! 60: */ ! 61: p1 = buf; ! 62: p2 = env_name; ! 63: while ((ch = *p1++) != '\0') { ! 64: if(ch == '/') p2 = env_name; ! 65: else if(ch != '.') *p2++ = ch; ! 66: } ! 67: if(p2 != env_name) { ! 68: *p2 = '\0'; ! 69: if( (env_val = getenv( env_name )) != NULL ) { ! 70: if(strlen(env_val) >= BUF_LEN-1 ) ! 71: err(errflag,F_ERSTAT,"open: file name too long"); ! 72: strcpy(buf, env_val); ! 73: } ! 74: } ! 75: } ! 76: lfname = &buf[0]; ! 77: if(OPEN) ! 78: { ! 79: if(!a->ofnm || inode(buf)==b->uinode) ! 80: { ! 81: if(a->oblnk) b->ublnk= (lcase(*a->oblnk)== 'z'); ! 82: #ifndef KOSHER ! 83: if(a->ofm && b->ufmt) b->uprnt = (lcase(*a->ofm)== 'p'); ! 84: #endif ! 85: return(OK); ! 86: } ! 87: x.cunit=lunit; ! 88: x.csta=FROM_OPEN; ! 89: x.cerr=errflag; ! 90: if(n=f_clos(&x)) return(n); ! 91: } ! 92: exists = (stat(buf,&sbuf)==NULL); ! 93: if(!exists && OLD) err(errflag,F_EROLDF,"open"); ! 94: if( exists && NEW) err(errflag,F_ERNEWF,"open"); ! 95: errno = F_ERSYS; ! 96: if(isdev(buf)) ! 97: { if((b->ufd = fopen(buf,"r")) != NULL) b->uwrt = NO; ! 98: else err(errflag,errno,buf) ! 99: } ! 100: else ! 101: { ! 102: errno = F_ERSYS; ! 103: if((b->ufd = fopen(buf, "a")) != NULL) ! 104: { if(!opneof) ! 105: { if(freopen(buf, "r", b->ufd) != NULL) ! 106: b->uwrt = NO; ! 107: else ! 108: err(errflag, errno, buf) ! 109: } ! 110: else ! 111: b->uwrt = YES; ! 112: } ! 113: else if((b->ufd = fopen(buf, "r")) != NULL) ! 114: { if (opneof) ! 115: fseek(b->ufd, 0L, 2); ! 116: b->uwrt = NO; ! 117: } ! 118: else err(errflag, errno, buf) ! 119: } ! 120: if((b->uinode=finode(b->ufd))==-1) err(errflag,F_ERSTAT,"open") ! 121: b->ufnm = (char *) calloc(strlen(buf)+1,sizeof(char)); ! 122: if(b->ufnm==NULL) err(errflag,F_ERSPACE,"open") ! 123: strcpy(b->ufnm,buf); ! 124: b->uscrtch = SCRATCH; ! 125: b->uend = NO; ! 126: b->useek = canseek(b->ufd); ! 127: if (a->oacc == NULL) ! 128: a->oacc = "seq"; ! 129: if (lcase(*a->oacc)=='s' && a->orl > 0) ! 130: { ! 131: fputs("Warning: open: record length ignored on sequential access\n", units[0].ufd); ! 132: b->url = 0; ! 133: } ! 134: else if (a->orl < 0 || (lcase(*a->oacc)=='d' && a->orl == 0)) ! 135: err(errflag,F_ERARG,"recl on open") ! 136: else ! 137: b->url = a->orl; ! 138: if (a->oblnk) ! 139: b->ublnk = (lcase(*a->oblnk)=='z'); ! 140: else if (lunit == STDERR) ! 141: b->ublnk = NO; ! 142: else ! 143: b->ublnk = blzero; ! 144: if (a->ofm) ! 145: { ! 146: switch(lcase(*a->ofm)) ! 147: { ! 148: case 'f': ! 149: b->ufmt = YES; ! 150: b->uprnt = NO; ! 151: break; ! 152: #ifndef KOSHER ! 153: case 'p': /* print file *** NOT STANDARD FORTRAN ***/ ! 154: b->ufmt = YES; ! 155: b->uprnt = YES; ! 156: break; ! 157: #endif ! 158: case 'u': ! 159: b->ufmt = NO; ! 160: b->uprnt = NO; ! 161: break; ! 162: default: ! 163: err(errflag,F_ERARG,"open form=") ! 164: } ! 165: } ! 166: else /* not specified */ ! 167: { b->ufmt = (b->url==0); ! 168: if (lunit == STDERR) ! 169: b->uprnt = NO; ! 170: else ! 171: b->uprnt = ccntrl; ! 172: } ! 173: if(b->url && b->useek) rewind(b->ufd); ! 174: return(OK); ! 175: } ! 176: ! 177: fk_open(rd,seq,fmt,n) ftnint n; ! 178: { char nbuf[10]; ! 179: olist a; ! 180: sprintf(nbuf, fortfile, (int)n); ! 181: a.oerr=errflag; ! 182: a.ounit=n; ! 183: a.ofnm=nbuf; ! 184: a.ofnmlen=strlen(nbuf); ! 185: a.osta=NULL; ! 186: a.oacc= seq==SEQ?"s":"d"; ! 187: a.ofm = fmt==FMT?"f":"u"; ! 188: a.orl = seq==DIR?1:0; ! 189: a.oblnk=NULL; ! 190: return(f_open(&a)); ! 191: } ! 192: ! 193: LOCAL ! 194: isdev(s) char *s; ! 195: { struct stat x; ! 196: int j; ! 197: if(stat(s, &x) == -1) return(NO); ! 198: if((j = (x.st_mode&S_IFMT)) == S_IFREG || j == S_IFDIR) return(NO); ! 199: else return(YES); ! 200: } ! 201: ! 202: /*initialization routine*/ ! 203: f_init() ! 204: { ! 205: ini_std(STDERR, stderr, WRITE); ! 206: ini_std(STDIN, stdin, READ); ! 207: ini_std(STDOUT, stdout, WRITE); ! 208: setlinebuf(stderr); ! 209: } ! 210: ! 211: LOCAL ! 212: ini_std(u,F,w) FILE *F; ! 213: { unit *p; ! 214: p = &units[u]; ! 215: p->ufd = F; ! 216: p->ufnm = NULL; ! 217: p->useek = canseek(F); ! 218: p->ufmt = YES; ! 219: p->uwrt = (w==WRITE)? YES : NO; ! 220: p->uscrtch = p->uend = NO; ! 221: p->ublnk = blzero; ! 222: p->uprnt = ccntrl; ! 223: p->url = 0; ! 224: p->uinode = finode(F); ! 225: } ! 226: ! 227: LOCAL ! 228: canseek(f) FILE *f; /*SYSDEP*/ ! 229: { struct stat x; ! 230: return( (fstat(fileno(f),&x)==0) && ! 231: (x.st_nlink > 0 /*!pipe*/) && !isatty(fileno(f)) ); ! 232: } ! 233: ! 234: LOCAL ! 235: finode(f) FILE *f; ! 236: { struct stat x; ! 237: if(fstat(fileno(f),&x)==0) return(x.st_ino); ! 238: else return(-1); ! 239: } ! 240: ! 241: inode(a) char *a; ! 242: { struct stat x; ! 243: if(stat(a,&x)==0) return(x.st_ino); ! 244: else return(-1); ! 245: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.