12485Sdlw /* 2*12105Sdlw char id_close[] = "@(#)close.c 1.5"; 32485Sdlw * 42485Sdlw * close.c - f77 file close, flush, exit routines 52485Sdlw */ 62485Sdlw 72485Sdlw #include "fio.h" 82485Sdlw 9*12105Sdlw static char FROM_OPEN[] = "\2"; 102485Sdlw 112485Sdlw f_clos(a) cllist *a; 122485Sdlw { unit *b; 134390Sdlw int n; 144390Sdlw 152485Sdlw lfname = NULL; 162485Sdlw elist = NO; 172485Sdlw external = YES; 182485Sdlw errflag = a->cerr; 192485Sdlw lunit = a->cunit; 202583Sdlw if(not_legal(lunit)) err(errflag,F_ERUNIT,"close"); 21*12105Sdlw if(lunit==STDERR && (!a->csta || *a->csta != FROM_OPEN[0])) 222583Sdlw err(errflag,F_ERUNIT,"can't close stderr"); 232485Sdlw b= &units[lunit]; 242583Sdlw if(!b->ufd) err(errflag,F_ERNOPEN,"close"); 25*12105Sdlw if(a->csta && *a->csta != FROM_OPEN[0]) 262485Sdlw switch(lcase(*a->csta)) 272485Sdlw { 282485Sdlw delete: 292485Sdlw case 'd': 302485Sdlw fclose(b->ufd); 312485Sdlw if(b->ufnm) unlink(b->ufnm); /*SYSDEP*/ 322485Sdlw break; 332485Sdlw default: 342485Sdlw keep: 352485Sdlw case 'k': 364390Sdlw if(b->uwrt && (n=t_runc(b,errflag))) return(n); 372485Sdlw fclose(b->ufd); 382485Sdlw break; 392485Sdlw } 402485Sdlw else if(b->uscrtch) goto delete; 412485Sdlw else goto keep; 422485Sdlw if(b->ufnm) free(b->ufnm); 432485Sdlw b->ufnm=NULL; 442485Sdlw b->ufd=NULL; 452485Sdlw return(OK); 462485Sdlw } 472485Sdlw 482485Sdlw f_exit() 492485Sdlw { 502485Sdlw ftnint lu, dofirst = YES; 512485Sdlw cllist xx; 522485Sdlw xx.cerr=1; 53*12105Sdlw xx.csta=FROM_OPEN; 542485Sdlw for(lu=STDOUT; (dofirst || lu!=STDOUT); lu = ++lu % MXUNIT) 552485Sdlw { 562485Sdlw xx.cunit=lu; 572485Sdlw f_clos(&xx); 582485Sdlw dofirst = NO; 592485Sdlw } 602485Sdlw } 612485Sdlw 622485Sdlw ftnint 632485Sdlw flush_(u) ftnint *u; 642485Sdlw { 6511908Sdlw FILE *F; 6611908Sdlw 6711908Sdlw if(not_legal(*u)) 6811908Sdlw return(F_ERUNIT); 6911908Sdlw F = units[*u].ufd; 702485Sdlw if(F) 712485Sdlw return(fflush(F)); 722485Sdlw else 732583Sdlw return(F_ERNOPEN); 742485Sdlw } 75