12485Sdlw /* 223067Skre * Copyright (c) 1980 Regents of the University of California. 323067Skre * All rights reserved. The Berkeley software License Agreement 423067Skre * specifies the terms and conditions for redistribution. 52485Sdlw * 6*40228Sdonn * @(#)close.c 5.3 02/25/90 723067Skre */ 823067Skre 923067Skre /* 1020984Slibs * f_clos(): f77 file close 1120984Slibs * t_runc(): truncation 1220984Slibs * f_exit(): I/O library exit routines 132485Sdlw */ 142485Sdlw 152485Sdlw #include "fio.h" 162485Sdlw 1712105Sdlw static char FROM_OPEN[] = "\2"; 1814825Sdlw static char clse[] = "close"; 192485Sdlw 202485Sdlw f_clos(a) cllist *a; 212485Sdlw { unit *b; 224390Sdlw int n; 234390Sdlw 242485Sdlw lfname = NULL; 252485Sdlw elist = NO; 262485Sdlw external = YES; 272485Sdlw errflag = a->cerr; 282485Sdlw lunit = a->cunit; 2924093Sjerry if(not_legal(lunit)) return(OK); 3012105Sdlw if(lunit==STDERR && (!a->csta || *a->csta != FROM_OPEN[0])) 312583Sdlw err(errflag,F_ERUNIT,"can't close stderr"); 322485Sdlw b= &units[lunit]; 3324093Sjerry if(!b->ufd) return(OK); 3412105Sdlw if(a->csta && *a->csta != FROM_OPEN[0]) 352485Sdlw switch(lcase(*a->csta)) 362485Sdlw { 372485Sdlw delete: 382485Sdlw case 'd': 392485Sdlw fclose(b->ufd); 402485Sdlw if(b->ufnm) unlink(b->ufnm); /*SYSDEP*/ 412485Sdlw break; 422485Sdlw default: 432485Sdlw keep: 442485Sdlw case 'k': 4514825Sdlw if(b->uwrt && (n=t_runc(b,errflag,clse))) return(n); 462485Sdlw fclose(b->ufd); 472485Sdlw break; 482485Sdlw } 492485Sdlw else if(b->uscrtch) goto delete; 502485Sdlw else goto keep; 512485Sdlw if(b->ufnm) free(b->ufnm); 522485Sdlw b->ufnm=NULL; 532485Sdlw b->ufd=NULL; 542485Sdlw return(OK); 552485Sdlw } 562485Sdlw 572485Sdlw f_exit() 582485Sdlw { 592485Sdlw ftnint lu, dofirst = YES; 602485Sdlw cllist xx; 612485Sdlw xx.cerr=1; 6212105Sdlw xx.csta=FROM_OPEN; 632485Sdlw for(lu=STDOUT; (dofirst || lu!=STDOUT); lu = ++lu % MXUNIT) 642485Sdlw { 652485Sdlw xx.cunit=lu; 662485Sdlw f_clos(&xx); 672485Sdlw dofirst = NO; 682485Sdlw } 692485Sdlw } 702485Sdlw 71*40228Sdonn t_runc (b, flg, str) 7220984Slibs unit *b; 73*40228Sdonn ioflag flg; 7420984Slibs char *str; 752485Sdlw { 7620984Slibs long loc; 7711908Sdlw 7820984Slibs if (b->uwrt) 7920984Slibs fflush (b->ufd); 8020984Slibs if (b->url || !b->useek || !b->ufnm) 8120984Slibs return (OK); /* don't truncate direct access files, etc. */ 8220984Slibs loc = ftell (b->ufd); 8320984Slibs if (truncate (b->ufnm, loc) != 0) 84*40228Sdonn err (flg, errno, str) 8520984Slibs if (b->uwrt && ! nowreading(b)) 86*40228Sdonn err (flg, errno, str) 8720984Slibs return (OK); 882485Sdlw } 89