/* char id_open[] = "@(#)open.c 1.10"; * * open.c - f77 file open routines */ #include #include #include #include "fio.h" #define SCRATCH (st=='s') #define NEW (st=='n') #define OLD (st=='o') #define OPEN (b->ufd) #define FROM_OPEN "\2" /* for use in f_clos() */ extern char *tmplate; extern char *fortfile; f_open(a) olist *a; { unit *b; int n,exists; char buf[256],st; cllist x; lfname = NULL; elist = NO; external = YES; /* for err */ errflag = a->oerr; lunit = a->ounit; if(not_legal(lunit)) err(errflag,F_ERUNIT,"open") b= &units[lunit]; if(a->osta) st = lcase(*a->osta); else st = 'u'; if(SCRATCH) { strcpy(buf,tmplate); mktemp(buf); } else if(a->ofnm) g_char(a->ofnm,a->ofnmlen,buf); else sprintf(buf,fortfile,lunit); lfname = &buf[0]; if(OPEN) { if(!a->ofnm || inode(buf)==b->uinode) { if(a->oblnk) b->ublnk= (lcase(*a->oblnk)== 'z'); #ifndef KOSHER if(a->ofm && b->ufmt) b->uprnt = (lcase(*a->ofm)== 'p'); #endif return(OK); } x.cunit=lunit; x.csta=FROM_OPEN; x.cerr=errflag; if(n=f_clos(&x)) return(n); } exists = (access(buf,0)==NULL); if(!exists && OLD) err(errflag,F_EROLDF,"open"); if( exists && NEW) err(errflag,F_ERNEWF,"open"); if(isdev(buf)) { if((b->ufd = fopen(buf,"r")) != NULL) b->uwrt = NO; else err(errflag,errno,buf) } else { if((b->ufd = fopen(buf, "a")) != NULL) { if(!opneof) { if(freopen(buf, "r", b->ufd) != NULL) b->uwrt = NO; else err(errflag, errno, buf) } else b->uwrt = YES; } else if((b->ufd = fopen(buf, "r")) != NULL) { if (opneof) fseek(b->ufd, 0L, 2); b->uwrt = NO; } else err(errflag, errno, buf) } if((b->uinode=finode(b->ufd))==-1) err(errflag,F_ERSTAT,"open") b->ufnm = (char *) calloc(strlen(buf)+1,sizeof(char)); if(b->ufnm==NULL) err(errflag,F_ERSPACE,"open") strcpy(b->ufnm,buf); b->uscrtch = SCRATCH; b->uend = NO; b->useek = canseek(b->ufd); if (a->oacc == NULL) a->oacc = "seq"; if (lcase(*a->oacc)=='s' && a->orl > 0) { fputs("Warning: open: record length ignored on sequential access\n", units[0].ufd); b->url = 0; } else if (a->orl < 0 || (lcase(*a->oacc)=='d' && a->orl == 0)) err(errflag,F_ERARG,"recl on open") else b->url = a->orl; if (a->oblnk) b->ublnk = (lcase(*a->oblnk)=='z'); else if (lunit == STDERR) b->ublnk = NO; else b->ublnk = blzero; if (a->ofm) { switch(lcase(*a->ofm)) { case 'f': b->ufmt = YES; b->uprnt = NO; break; #ifndef KOSHER case 'p': /* print file *** NOT STANDARD FORTRAN ***/ b->ufmt = YES; b->uprnt = YES; break; #endif case 'u': b->ufmt = NO; b->uprnt = NO; break; default: err(errflag,F_ERARG,"open form=") } } else /* not specified */ { b->ufmt = (b->url==0); if (lunit == STDERR) b->uprnt = NO; else b->uprnt = ccntrl; } if(b->url && b->useek) rewind(b->ufd); return(OK); } fk_open(rd,seq,fmt,n) ftnint n; { char nbuf[10]; olist a; sprintf(nbuf, fortfile, (int)n); a.oerr=errflag; a.ounit=n; a.ofnm=nbuf; a.ofnmlen=strlen(nbuf); a.osta=NULL; a.oacc= seq==SEQ?"s":"d"; a.ofm = fmt==FMT?"f":"u"; a.orl = seq==DIR?1:0; a.oblnk=NULL; return(f_open(&a)); } isdev(s) char *s; { struct stat x; int j; if(stat(s, &x) == -1) return(NO); if((j = (x.st_mode&S_IFMT)) == S_IFREG || j == S_IFDIR) return(NO); else return(YES); }