|
|
1.1 ! root 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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.