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