12498Sdlw /* 2*12036Sdlw char id_open[] = "@(#)open.c 1.9"; 32498Sdlw * 42498Sdlw * open.c - f77 file open routines 52498Sdlw */ 62498Sdlw 72498Sdlw #include <sys/types.h> 82498Sdlw #include <sys/stat.h> 92498Sdlw #include <errno.h> 102498Sdlw #include "fio.h" 112498Sdlw 122498Sdlw #define SCRATCH (st=='s') 132498Sdlw #define NEW (st=='n') 142498Sdlw #define OLD (st=='o') 152498Sdlw #define OPEN (b->ufd) 162498Sdlw #define FROM_OPEN "\1" /* for use in f_clos() */ 172498Sdlw 182498Sdlw extern char *tmplate; 192498Sdlw extern char *fortfile; 202498Sdlw 212498Sdlw f_open(a) olist *a; 222498Sdlw { unit *b; 232498Sdlw int n,exists; 242498Sdlw char buf[256],st; 252498Sdlw cllist x; 262498Sdlw 272498Sdlw lfname = NULL; 282498Sdlw elist = NO; 292498Sdlw external = YES; /* for err */ 302498Sdlw errflag = a->oerr; 312498Sdlw lunit = a->ounit; 322597Sdlw if(not_legal(lunit)) err(errflag,F_ERUNIT,"open") 332498Sdlw b= &units[lunit]; 342498Sdlw if(a->osta) st = lcase(*a->osta); 352498Sdlw else st = 'u'; 362498Sdlw if(SCRATCH) 372498Sdlw { strcpy(buf,tmplate); 382498Sdlw mktemp(buf); 392498Sdlw } 402498Sdlw else if(a->ofnm) g_char(a->ofnm,a->ofnmlen,buf); 412498Sdlw else sprintf(buf,fortfile,lunit); 422498Sdlw lfname = &buf[0]; 432498Sdlw if(OPEN) 442498Sdlw { 452498Sdlw if(!a->ofnm || inode(buf)==b->uinode) 462498Sdlw { 472498Sdlw if(a->oblnk) b->ublnk= (lcase(*a->oblnk)== 'z'); 482498Sdlw #ifndef KOSHER 492498Sdlw if(a->ofm && b->ufmt) b->uprnt = (lcase(*a->ofm)== 'p'); 502498Sdlw #endif 512498Sdlw return(OK); 522498Sdlw } 532498Sdlw x.cunit=lunit; 542498Sdlw x.csta=FROM_OPEN; 552498Sdlw x.cerr=errflag; 562498Sdlw if(n=f_clos(&x)) return(n); 572498Sdlw } 582498Sdlw exists = (access(buf,0)==NULL); 592597Sdlw if(!exists && OLD) err(errflag,F_EROLDF,"open"); 602597Sdlw if( exists && NEW) err(errflag,F_ERNEWF,"open"); 612498Sdlw if(isdev(buf)) 622498Sdlw { if((b->ufd = fopen(buf,"r")) != NULL) b->uwrt = NO; 632498Sdlw else err(errflag,errno,buf) 642498Sdlw } 652498Sdlw else 6612010Sdlw { if((b->ufd = fopen(buf, "a")) != NULL) 67*12036Sdlw { if(!opneof) 6812010Sdlw { if(freopen(buf, "r", b->ufd) != NULL) 6912010Sdlw b->uwrt = NO; 7012010Sdlw else 7112010Sdlw err(errflag, errno, buf) 7212010Sdlw } 7312010Sdlw else 7412010Sdlw b->uwrt = YES; 7512010Sdlw } 762498Sdlw else if((b->ufd = fopen(buf, "r")) != NULL) 77*12036Sdlw { if (opneof) 7811907Sdlw fseek(b->ufd, 0L, 2); 792498Sdlw b->uwrt = NO; 802498Sdlw } 812498Sdlw else err(errflag, errno, buf) 822498Sdlw } 832597Sdlw if((b->uinode=finode(b->ufd))==-1) err(errflag,F_ERSTAT,"open") 842498Sdlw b->ufnm = (char *) calloc(strlen(buf)+1,sizeof(char)); 852597Sdlw if(b->ufnm==NULL) err(errflag,F_ERSPACE,"open") 862498Sdlw strcpy(b->ufnm,buf); 872498Sdlw b->uscrtch = SCRATCH; 882498Sdlw b->uend = NO; 892498Sdlw b->useek = canseek(b->ufd); 908943Sdlw if (a->oacc == NULL) 918943Sdlw a->oacc = "seq"; 928943Sdlw if (lcase(*a->oacc)=='s' && a->orl > 0) 938943Sdlw { 946604Sdlw fputs("Warning: open: record length ignored on sequential access\n", units[0].ufd); 958943Sdlw b->url = 0; 968943Sdlw } 978943Sdlw else if (a->orl < 0 || (lcase(*a->oacc)=='d' && a->orl == 0)) 986604Sdlw err(errflag,F_ERARG,"recl on open") 996604Sdlw else 1006604Sdlw b->url = a->orl; 10112008Sdlw if (a->oblnk) 10212008Sdlw b->ublnk = (lcase(*a->oblnk)=='z'); 10312008Sdlw else if (lunit == STDERR) 10412008Sdlw b->ublnk = NO; 10512008Sdlw else 10612024Sdlw b->ublnk = blzero; 1072498Sdlw if (a->ofm) 1082498Sdlw { 1092498Sdlw switch(lcase(*a->ofm)) 1102498Sdlw { 1112498Sdlw case 'f': 1122498Sdlw b->ufmt = YES; 1132498Sdlw b->uprnt = NO; 1142498Sdlw break; 1152498Sdlw #ifndef KOSHER 1162498Sdlw case 'p': /* print file *** NOT STANDARD FORTRAN ***/ 1172498Sdlw b->ufmt = YES; 1182498Sdlw b->uprnt = YES; 1192498Sdlw break; 1202498Sdlw #endif 1212498Sdlw case 'u': 1222498Sdlw b->ufmt = NO; 1232498Sdlw b->uprnt = NO; 1242498Sdlw break; 1252498Sdlw default: 1262597Sdlw err(errflag,F_ERARG,"open form=") 1272498Sdlw } 1282498Sdlw } 1292498Sdlw else /* not specified */ 1302498Sdlw { b->ufmt = (b->url==0); 13112008Sdlw if (lunit == STDERR) 13212008Sdlw b->uprnt = NO; 13312008Sdlw else 13412024Sdlw b->uprnt = ccntrl; 1352498Sdlw } 1362498Sdlw if(b->url && b->useek) rewind(b->ufd); 1372498Sdlw return(OK); 1382498Sdlw } 1392498Sdlw 1402498Sdlw fk_open(rd,seq,fmt,n) ftnint n; 1412498Sdlw { char nbuf[10]; 1422498Sdlw olist a; 1432498Sdlw sprintf(nbuf, fortfile, (int)n); 1442498Sdlw a.oerr=errflag; 1452498Sdlw a.ounit=n; 1462498Sdlw a.ofnm=nbuf; 1472498Sdlw a.ofnmlen=strlen(nbuf); 1482498Sdlw a.osta=NULL; 1492498Sdlw a.oacc= seq==SEQ?"s":"d"; 1502498Sdlw a.ofm = fmt==FMT?"f":"u"; 1512498Sdlw a.orl = seq==DIR?1:0; 1522498Sdlw a.oblnk=NULL; 1532498Sdlw return(f_open(&a)); 1542498Sdlw } 1552498Sdlw 1562498Sdlw isdev(s) char *s; 1572498Sdlw { struct stat x; 1582498Sdlw int j; 1592498Sdlw if(stat(s, &x) == -1) return(NO); 1602498Sdlw if((j = (x.st_mode&S_IFMT)) == S_IFREG || j == S_IFDIR) return(NO); 1612498Sdlw else return(YES); 1622498Sdlw } 1632498Sdlw 164