ghc/lib/std/cbits/freeFile.lc

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1997
   3 %
   4 \subsection[freeFile.lc]{Giving up files}
   5
   6 \begin{code}
   7
   8 #include "rtsdefs.h"
   9 #include "stgio.h"
  10 #include "fileObject.h"
  11
  12 /* sigh, the FILEs attached to the standard descriptors are
  13    handled differently. We don't want them freed via the
  14    ForeignObj finaliser, as we probably want to use these
  15    before we *really* shut down (dumping stats etc.)
  16 */
  17 void freeStdFile(fp)
  18 StgForeignObj fp;
  19 { return; }
  20
  21 void freeStdFileObject(ptr)
  22 StgForeignObj ptr;
  23 {
  24   IOFileObject* fo = (IOFileObject*)ptr;
  25
  26   /* Don't close the file, just flush the buffer */
  27   if (fo != NULL && fo->fd != -1) {
  28     if (fo->buf != NULL && (fo->flags & FILEOBJ_FLUSH) && fo->bufWPtr > 0) {
  29        /* Flush buffer contents */
  30        writeBuffer((StgForeignObj)fo, fo->bufWPtr);
  31     }
  32   }
  33 }
  34
  35 void freeFileObject(ptr)
  36 StgForeignObj ptr;
  37 {
  38     /*
  39      * The finaliser for the file objects embedded in Handles. The RTS
  40      * assumes that the finaliser runs without problems, so all
  41      * we can do here is flish buffers + close(), and hope nothing went wrong.
  42      *
  43      */
  44
  45     int rc;
  46     IOFileObject* fo = (IOFileObject*)ptr;
  47
  48     if ( fo == NULL )
  49       return;
  50
  51     if ( fo->fd == -1 || (rc = unlockFile(fo->fd)) ) {
  52         /* If the file handle has been explicitly closed
  53          * (via closeFile()), we will have given
  54          * up our process lock, so we break off and just return.
  55          */
  56        return;
  57     }
  58
  59     if (fo->buf != NULL && fo->bufWPtr > 0) {
  60        /* Flush buffer contents before closing underlying file */
  61        fo->flags &= ~FILEOBJ_RW_WRITE | ~FILEOBJ_RW_READ;
  62        flushFile(ptr);
  63     }
  64
  65     rc = close(fo->fd);
  66     /* Error or no error, we don't care.. */
  67
  68     return;
  69 }
  70 \end{code}