1*47943Sbostic /*-
2*47943Sbostic * Copyright (c) 1980 The Regents of the University of California.
3*47943Sbostic * All rights reserved.
42485Sdlw *
5*47943Sbostic * %sccs.include.proprietary.c%
623067Skre */
723067Skre
8*47943Sbostic #ifndef lint
9*47943Sbostic static char sccsid[] = "@(#)close.c 5.4 (Berkeley) 04/12/91";
10*47943Sbostic #endif /* not lint */
11*47943Sbostic
1223067Skre /*
1320984Slibs * f_clos(): f77 file close
1420984Slibs * t_runc(): truncation
1520984Slibs * f_exit(): I/O library exit routines
162485Sdlw */
172485Sdlw
182485Sdlw #include "fio.h"
192485Sdlw
2012105Sdlw static char FROM_OPEN[] = "\2";
2114825Sdlw static char clse[] = "close";
222485Sdlw
f_clos(a)232485Sdlw f_clos(a) cllist *a;
242485Sdlw { unit *b;
254390Sdlw int n;
264390Sdlw
272485Sdlw lfname = NULL;
282485Sdlw elist = NO;
292485Sdlw external = YES;
302485Sdlw errflag = a->cerr;
312485Sdlw lunit = a->cunit;
3224093Sjerry if(not_legal(lunit)) return(OK);
3312105Sdlw if(lunit==STDERR && (!a->csta || *a->csta != FROM_OPEN[0]))
342583Sdlw err(errflag,F_ERUNIT,"can't close stderr");
352485Sdlw b= &units[lunit];
3624093Sjerry if(!b->ufd) return(OK);
3712105Sdlw if(a->csta && *a->csta != FROM_OPEN[0])
382485Sdlw switch(lcase(*a->csta))
392485Sdlw {
402485Sdlw delete:
412485Sdlw case 'd':
422485Sdlw fclose(b->ufd);
432485Sdlw if(b->ufnm) unlink(b->ufnm); /*SYSDEP*/
442485Sdlw break;
452485Sdlw default:
462485Sdlw keep:
472485Sdlw case 'k':
4814825Sdlw if(b->uwrt && (n=t_runc(b,errflag,clse))) return(n);
492485Sdlw fclose(b->ufd);
502485Sdlw break;
512485Sdlw }
522485Sdlw else if(b->uscrtch) goto delete;
532485Sdlw else goto keep;
542485Sdlw if(b->ufnm) free(b->ufnm);
552485Sdlw b->ufnm=NULL;
562485Sdlw b->ufd=NULL;
572485Sdlw return(OK);
582485Sdlw }
592485Sdlw
f_exit()602485Sdlw f_exit()
612485Sdlw {
622485Sdlw ftnint lu, dofirst = YES;
632485Sdlw cllist xx;
642485Sdlw xx.cerr=1;
6512105Sdlw xx.csta=FROM_OPEN;
662485Sdlw for(lu=STDOUT; (dofirst || lu!=STDOUT); lu = ++lu % MXUNIT)
672485Sdlw {
682485Sdlw xx.cunit=lu;
692485Sdlw f_clos(&xx);
702485Sdlw dofirst = NO;
712485Sdlw }
722485Sdlw }
732485Sdlw
t_runc(b,flg,str)7440228Sdonn t_runc (b, flg, str)
7520984Slibs unit *b;
7640228Sdonn ioflag flg;
7720984Slibs char *str;
782485Sdlw {
7920984Slibs long loc;
8011908Sdlw
8120984Slibs if (b->uwrt)
8220984Slibs fflush (b->ufd);
8320984Slibs if (b->url || !b->useek || !b->ufnm)
8420984Slibs return (OK); /* don't truncate direct access files, etc. */
8520984Slibs loc = ftell (b->ufd);
8620984Slibs if (truncate (b->ufnm, loc) != 0)
8740228Sdonn err (flg, errno, str)
8820984Slibs if (b->uwrt && ! nowreading(b))
8940228Sdonn err (flg, errno, str)
9020984Slibs return (OK);
912485Sdlw }
92