12485Sdlw /* 2*20984Slibs char id_close[] = "@(#)close.c 1.7"; 32485Sdlw * 4*20984Slibs * f_clos(): f77 file close 5*20984Slibs * t_runc(): truncation 6*20984Slibs * f_exit(): I/O library exit routines 72485Sdlw */ 82485Sdlw 92485Sdlw #include "fio.h" 102485Sdlw 1112105Sdlw static char FROM_OPEN[] = "\2"; 1214825Sdlw static char clse[] = "close"; 132485Sdlw 142485Sdlw f_clos(a) cllist *a; 152485Sdlw { unit *b; 164390Sdlw int n; 174390Sdlw 182485Sdlw lfname = NULL; 192485Sdlw elist = NO; 202485Sdlw external = YES; 212485Sdlw errflag = a->cerr; 222485Sdlw lunit = a->cunit; 2314825Sdlw if(not_legal(lunit)) err(errflag,F_ERUNIT,clse); 2412105Sdlw if(lunit==STDERR && (!a->csta || *a->csta != FROM_OPEN[0])) 252583Sdlw err(errflag,F_ERUNIT,"can't close stderr"); 262485Sdlw b= &units[lunit]; 2714825Sdlw if(!b->ufd) err(errflag,F_ERNOPEN,clse); 2812105Sdlw if(a->csta && *a->csta != FROM_OPEN[0]) 292485Sdlw switch(lcase(*a->csta)) 302485Sdlw { 312485Sdlw delete: 322485Sdlw case 'd': 332485Sdlw fclose(b->ufd); 342485Sdlw if(b->ufnm) unlink(b->ufnm); /*SYSDEP*/ 352485Sdlw break; 362485Sdlw default: 372485Sdlw keep: 382485Sdlw case 'k': 3914825Sdlw if(b->uwrt && (n=t_runc(b,errflag,clse))) return(n); 402485Sdlw fclose(b->ufd); 412485Sdlw break; 422485Sdlw } 432485Sdlw else if(b->uscrtch) goto delete; 442485Sdlw else goto keep; 452485Sdlw if(b->ufnm) free(b->ufnm); 462485Sdlw b->ufnm=NULL; 472485Sdlw b->ufd=NULL; 482485Sdlw return(OK); 492485Sdlw } 502485Sdlw 512485Sdlw f_exit() 522485Sdlw { 532485Sdlw ftnint lu, dofirst = YES; 542485Sdlw cllist xx; 552485Sdlw xx.cerr=1; 5612105Sdlw xx.csta=FROM_OPEN; 572485Sdlw for(lu=STDOUT; (dofirst || lu!=STDOUT); lu = ++lu % MXUNIT) 582485Sdlw { 592485Sdlw xx.cunit=lu; 602485Sdlw f_clos(&xx); 612485Sdlw dofirst = NO; 622485Sdlw } 632485Sdlw } 642485Sdlw 65*20984Slibs t_runc (b, flag, str) 66*20984Slibs unit *b; 67*20984Slibs ioflag flag; 68*20984Slibs char *str; 692485Sdlw { 70*20984Slibs long loc; 7111908Sdlw 72*20984Slibs if (b->uwrt) 73*20984Slibs fflush (b->ufd); 74*20984Slibs if (b->url || !b->useek || !b->ufnm) 75*20984Slibs return (OK); /* don't truncate direct access files, etc. */ 76*20984Slibs loc = ftell (b->ufd); 77*20984Slibs if (truncate (b->ufnm, loc) != 0) 78*20984Slibs err (flag, errno, str) 79*20984Slibs if (b->uwrt && ! nowreading(b)) 80*20984Slibs err (flag, errno, str) 81*20984Slibs return (OK); 822485Sdlw } 83