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