1: /*
2: * Copyright (c) 1980 Regents of the University of California.
3: * All rights reserved. The Berkeley software License Agreement
4: * specifies the terms and conditions for redistribution.
5: *
6: * @(#)close.c 5.2 7/30/85
7: */
8:
9: /*
10: * f_clos(): f77 file close
11: * t_runc(): truncation
12: * f_exit(): I/O library exit routines
13: */
14:
15: #include "fio.h"
16:
17: static char FROM_OPEN[] = "\2";
18: static char clse[] = "close";
19:
20: f_clos(a) cllist *a;
21: { unit *b;
22: int n;
23:
24: lfname = NULL;
25: elist = NO;
26: external = YES;
27: errflag = a->cerr;
28: lunit = a->cunit;
29: if(not_legal(lunit)) return(OK);
30: if(lunit==STDERR && (!a->csta || *a->csta != FROM_OPEN[0]))
31: err(errflag,F_ERUNIT,"can't close stderr");
32: b= &units[lunit];
33: if(!b->ufd) return(OK);
34: if(a->csta && *a->csta != FROM_OPEN[0])
35: switch(lcase(*a->csta))
36: {
37: delete:
38: case 'd':
39: fclose(b->ufd);
40: if(b->ufnm) unlink(b->ufnm); /*SYSDEP*/
41: break;
42: default:
43: keep:
44: case 'k':
45: if(b->uwrt && (n=t_runc(b,errflag,clse))) return(n);
46: fclose(b->ufd);
47: break;
48: }
49: else if(b->uscrtch) goto delete;
50: else goto keep;
51: if(b->ufnm) free(b->ufnm);
52: b->ufnm=NULL;
53: b->ufd=NULL;
54: return(OK);
55: }
56:
57: f_exit()
58: {
59: ftnint lu, dofirst = YES;
60: cllist xx;
61: xx.cerr=1;
62: xx.csta=FROM_OPEN;
63: for(lu=STDOUT; (dofirst || lu!=STDOUT); lu = ++lu % MXUNIT)
64: {
65: xx.cunit=lu;
66: f_clos(&xx);
67: dofirst = NO;
68: }
69: }
70:
71: t_runc (b, flag, str)
72: unit *b;
73: ioflag flag;
74: char *str;
75: {
76: long loc;
77:
78: if (b->uwrt)
79: fflush (b->ufd);
80: if (b->url || !b->useek || !b->ufnm)
81: return (OK); /* don't truncate direct access files, etc. */
82: loc = ftell (b->ufd);
83: if (truncate (b->ufnm, loc) != 0)
84: err (flag, errno, str)
85: if (b->uwrt && ! nowreading(b))
86: err (flag, errno, str)
87: return (OK);
88: }
Defined functions
Defined variables
clse
defined in line
18; used 1 times