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