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