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