[project @ 2001-05-18 14:18:34 by simonmar]
[ghc-hetmet.git] / ghc / lib / std / cbits / closeFile.c
1 /* 
2  * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
3  *
4  * $Id: closeFile.c,v 1.10 2000/09/25 10:48:50 simonmar Exp $
5  *
6  * hClose Runtime Support
7  */
8
9 #include "Rts.h"
10 #include "stgio.h"
11 #include <errno.h>
12
13 #if defined(HAVE_WINSOCK_H) && !defined(__CYGWIN__) && !defined(__CYGWIN32__)
14 #define USE_WINSOCK
15 #endif
16
17 #ifdef USE_WINSOCK
18 #include <winsock.h>
19 #endif
20
21 StgInt __really_close_stdfiles=1;
22
23 StgInt
24 closeFile(StgForeignPtr ptr, StgInt flush_buf)
25 {
26     IOFileObject* fo = (IOFileObject*)ptr;
27     int rc = 0;
28     int unlocked=1;
29
30     /* Already closed, shouldn't occur. */
31     if ( fo == NULL ) {
32        return 0;
33     }
34
35     /* Flush buffer if we have unwritten data */
36     if ( flush_buf != 0 ) {
37         flushBuffer(fo);
38     }
39
40     /* If the flush failed, we ignore this and soldier on.. */
41
42     if ( unlockFile(fo->fd) ) {
43       /* If the file has already been unlocked (or an entry
44          for it in the locking tables couldn't be found), could
45          mean two things:
46
47             - we're repeating an hClose on an already
48               closed file (this is likely to be a bug
49               in the implementation of hClose, as this 
50               condition should have been caught before
51               we ended up here.)
52               
53             - the file wasn't locked in the first place!
54               (file descriptors to non regular files.)
55
56          We proceed with attempting to close the file,
57          but don't flag the error should close() return
58          EBADF
59       */
60         unlocked=0;
61         
62     }
63
64     /* Free the buffer straight away.  We can't free the file object
65      * itself until the finalizer runs.
66      */
67     if ( fo->buf != NULL ) {
68        free(fo->buf);
69        fo->buf = NULL;
70     }
71
72     /* Closing file descriptors that refer to standard channels
73        is problematic, so we back off from doing this by default,
74        just closing them at the Handle level. If you insist on
75        closing them, setting the (global) variable 
76        __really_close_stdfiles to 0 turns off this behaviour.
77     */
78     if ( (fo->flags & FILEOBJ_STD) && __really_close_stdfiles ) {
79         ;
80
81     } else  {
82       /* Regardless of success or otherwise, the fd field gets smashed. */
83       while ( (rc = 
84                 (
85 #ifdef USE_WINSOCK
86                   fo->flags & FILEOBJ_WINSOCK ?
87                   closesocket(fo->fd) :
88                   close(fo->fd))) != 0 ) {
89 #else
90                   close(fo->fd))) != 0 ) {
91 #endif
92          /* See above unlockFile() comment */
93          if ( errno != EINTR && (!unlocked && errno != EBADF ) ) {
94             cvtErrno();
95             stdErrno();
96             fo->fd = -1;
97             return rc;
98         }
99       }
100     }
101
102     fo->fd = -1;
103
104     return 0;
105 }