12485Sdlw /* 2*2583Sdlw char id_close[] = "@(#)close.c 1.2"; 32485Sdlw * 42485Sdlw * close.c - f77 file close, flush, exit routines 52485Sdlw */ 62485Sdlw 72485Sdlw #include "fio.h" 82485Sdlw 92485Sdlw #define FROM_OPEN '\1' 102485Sdlw 112485Sdlw f_clos(a) cllist *a; 122485Sdlw { unit *b; 132485Sdlw lfname = NULL; 142485Sdlw elist = NO; 152485Sdlw external = YES; 162485Sdlw errflag = a->cerr; 172485Sdlw lunit = a->cunit; 18*2583Sdlw if(not_legal(lunit)) err(errflag,F_ERUNIT,"close"); 192485Sdlw if(lunit==STDERR && (!a->csta || *a->csta != FROM_OPEN)) 20*2583Sdlw err(errflag,F_ERUNIT,"can't close stderr"); 212485Sdlw b= &units[lunit]; 22*2583Sdlw if(!b->ufd) err(errflag,F_ERNOPEN,"close"); 232485Sdlw if(a->csta) 242485Sdlw switch(lcase(*a->csta)) 252485Sdlw { 262485Sdlw delete: 272485Sdlw case 'd': 282485Sdlw fclose(b->ufd); 292485Sdlw if(b->ufnm) unlink(b->ufnm); /*SYSDEP*/ 302485Sdlw break; 312485Sdlw default: 322485Sdlw keep: 332485Sdlw case 'k': 342485Sdlw if(b->uwrt) t_runc(b,errflag); 352485Sdlw fclose(b->ufd); 362485Sdlw break; 372485Sdlw } 382485Sdlw else if(b->uscrtch) goto delete; 392485Sdlw else goto keep; 402485Sdlw if(b->ufnm) free(b->ufnm); 412485Sdlw b->ufnm=NULL; 422485Sdlw b->ufd=NULL; 432485Sdlw return(OK); 442485Sdlw } 452485Sdlw 462485Sdlw f_exit() 472485Sdlw { 482485Sdlw ftnint lu, dofirst = YES; 492485Sdlw cllist xx; 502485Sdlw xx.cerr=1; 512485Sdlw xx.csta=NULL; 522485Sdlw for(lu=STDOUT; (dofirst || lu!=STDOUT); lu = ++lu % MXUNIT) 532485Sdlw { 542485Sdlw xx.cunit=lu; 552485Sdlw f_clos(&xx); 562485Sdlw dofirst = NO; 572485Sdlw } 582485Sdlw } 592485Sdlw 602485Sdlw ftnint 612485Sdlw flush_(u) ftnint *u; 622485Sdlw { 632485Sdlw FILE *F = units[*u].ufd; 642485Sdlw if(F) 652485Sdlw return(fflush(F)); 662485Sdlw else 67*2583Sdlw return(F_ERNOPEN); 682485Sdlw } 69