|
|
1.1 ! root 1: /* ! 2: char id_close[] = "@(#)close.c 1.6"; ! 3: * ! 4: * close.c - f77 file close, flush, exit routines ! 5: */ ! 6: ! 7: #include "fio.h" ! 8: ! 9: static char FROM_OPEN[] = "\2"; ! 10: static char clse[] = "close"; ! 11: ! 12: f_clos(a) cllist *a; ! 13: { unit *b; ! 14: int n; ! 15: ! 16: lfname = NULL; ! 17: elist = NO; ! 18: external = YES; ! 19: errflag = a->cerr; ! 20: lunit = a->cunit; ! 21: if(not_legal(lunit)) err(errflag,F_ERUNIT,clse); ! 22: if(lunit==STDERR && (!a->csta || *a->csta != FROM_OPEN[0])) ! 23: err(errflag,F_ERUNIT,"can't close stderr"); ! 24: b= &units[lunit]; ! 25: if(!b->ufd) err(errflag,F_ERNOPEN,clse); ! 26: if(a->csta && *a->csta != FROM_OPEN[0]) ! 27: switch(lcase(*a->csta)) ! 28: { ! 29: delete: ! 30: case 'd': ! 31: fclose(b->ufd); ! 32: if(b->ufnm) unlink(b->ufnm); /*SYSDEP*/ ! 33: break; ! 34: default: ! 35: keep: ! 36: case 'k': ! 37: if(b->uwrt && (n=t_runc(b,errflag,clse))) return(n); ! 38: fclose(b->ufd); ! 39: break; ! 40: } ! 41: else if(b->uscrtch) goto delete; ! 42: else goto keep; ! 43: if(b->ufnm) free(b->ufnm); ! 44: b->ufnm=NULL; ! 45: b->ufd=NULL; ! 46: return(OK); ! 47: } ! 48: ! 49: f_exit() ! 50: { ! 51: ftnint lu, dofirst = YES; ! 52: cllist xx; ! 53: xx.cerr=1; ! 54: xx.csta=FROM_OPEN; ! 55: for(lu=STDOUT; (dofirst || lu!=STDOUT); lu = ++lu % MXUNIT) ! 56: { ! 57: xx.cunit=lu; ! 58: f_clos(&xx); ! 59: dofirst = NO; ! 60: } ! 61: } ! 62: ! 63: ftnint ! 64: flush_(u) ftnint *u; ! 65: { ! 66: FILE *F; ! 67: ! 68: if(not_legal(*u)) ! 69: return(F_ERUNIT); ! 70: F = units[*u].ufd; ! 71: if(F) ! 72: return(fflush(F)); ! 73: else ! 74: return(F_ERNOPEN); ! 75: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.