string.h is ANSI C include file
[unix-history] / usr / src / usr.bin / f77 / libI77 / close.c
CommitLineData
e798709f 1/*
161423a6
RE
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.
e798709f 5 *
7784fa72 6 * @(#)close.c 5.3 %G%
161423a6
RE
7 */
8
9/*
5e52dbf7
DL
10 * f_clos(): f77 file close
11 * t_runc(): truncation
12 * f_exit(): I/O library exit routines
e798709f
DW
13 */
14
15#include "fio.h"
16
84c777c9 17static char FROM_OPEN[] = "\2";
331ef099 18static char clse[] = "close";
e798709f
DW
19
20f_clos(a) cllist *a;
21{ unit *b;
2a05aacc
DW
22 int n;
23
e798709f
DW
24 lfname = NULL;
25 elist = NO;
26 external = YES;
27 errflag = a->cerr;
28 lunit = a->cunit;
70307d95 29 if(not_legal(lunit)) return(OK);
84c777c9 30 if(lunit==STDERR && (!a->csta || *a->csta != FROM_OPEN[0]))
3bbbaca0 31 err(errflag,F_ERUNIT,"can't close stderr");
e798709f 32 b= &units[lunit];
70307d95 33 if(!b->ufd) return(OK);
84c777c9 34 if(a->csta && *a->csta != FROM_OPEN[0])
e798709f
DW
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':
331ef099 45 if(b->uwrt && (n=t_runc(b,errflag,clse))) return(n);
e798709f
DW
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
57f_exit()
58{
59 ftnint lu, dofirst = YES;
60 cllist xx;
61 xx.cerr=1;
84c777c9 62 xx.csta=FROM_OPEN;
e798709f
DW
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
7784fa72 71t_runc (b, flg, str)
5e52dbf7 72unit *b;
7784fa72 73ioflag flg;
5e52dbf7 74char *str;
e798709f 75{
5e52dbf7 76 long loc;
c4793abe 77
5e52dbf7
DL
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)
7784fa72 84 err (flg, errno, str)
5e52dbf7 85 if (b->uwrt && ! nowreading(b))
7784fa72 86 err (flg, errno, str)
5e52dbf7 87 return (OK);
e798709f 88}