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