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