12485Sdlw /* 2*14825Sdlw char id_close[] = "@(#)close.c 1.6"; 32485Sdlw * 42485Sdlw * close.c - f77 file close, flush, exit routines 52485Sdlw */ 62485Sdlw 72485Sdlw #include "fio.h" 82485Sdlw 912105Sdlw static char FROM_OPEN[] = "\2"; 10*14825Sdlw static char clse[] = "close"; 112485Sdlw 122485Sdlw f_clos(a) cllist *a; 132485Sdlw { unit *b; 144390Sdlw int n; 154390Sdlw 162485Sdlw lfname = NULL; 172485Sdlw elist = NO; 182485Sdlw external = YES; 192485Sdlw errflag = a->cerr; 202485Sdlw lunit = a->cunit; 21*14825Sdlw if(not_legal(lunit)) err(errflag,F_ERUNIT,clse); 2212105Sdlw if(lunit==STDERR && (!a->csta || *a->csta != FROM_OPEN[0])) 232583Sdlw err(errflag,F_ERUNIT,"can't close stderr"); 242485Sdlw b= &units[lunit]; 25*14825Sdlw if(!b->ufd) err(errflag,F_ERNOPEN,clse); 2612105Sdlw if(a->csta && *a->csta != FROM_OPEN[0]) 272485Sdlw switch(lcase(*a->csta)) 282485Sdlw { 292485Sdlw delete: 302485Sdlw case 'd': 312485Sdlw fclose(b->ufd); 322485Sdlw if(b->ufnm) unlink(b->ufnm); /*SYSDEP*/ 332485Sdlw break; 342485Sdlw default: 352485Sdlw keep: 362485Sdlw case 'k': 37*14825Sdlw if(b->uwrt && (n=t_runc(b,errflag,clse))) return(n); 382485Sdlw fclose(b->ufd); 392485Sdlw break; 402485Sdlw } 412485Sdlw else if(b->uscrtch) goto delete; 422485Sdlw else goto keep; 432485Sdlw if(b->ufnm) free(b->ufnm); 442485Sdlw b->ufnm=NULL; 452485Sdlw b->ufd=NULL; 462485Sdlw return(OK); 472485Sdlw } 482485Sdlw 492485Sdlw f_exit() 502485Sdlw { 512485Sdlw ftnint lu, dofirst = YES; 522485Sdlw cllist xx; 532485Sdlw xx.cerr=1; 5412105Sdlw xx.csta=FROM_OPEN; 552485Sdlw for(lu=STDOUT; (dofirst || lu!=STDOUT); lu = ++lu % MXUNIT) 562485Sdlw { 572485Sdlw xx.cunit=lu; 582485Sdlw f_clos(&xx); 592485Sdlw dofirst = NO; 602485Sdlw } 612485Sdlw } 622485Sdlw 632485Sdlw ftnint 642485Sdlw flush_(u) ftnint *u; 652485Sdlw { 6611908Sdlw FILE *F; 6711908Sdlw 6811908Sdlw if(not_legal(*u)) 6911908Sdlw return(F_ERUNIT); 7011908Sdlw F = units[*u].ufd; 712485Sdlw if(F) 722485Sdlw return(fflush(F)); 732485Sdlw else 742583Sdlw return(F_ERNOPEN); 752485Sdlw } 76