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: }