ghc/lib/std/cbits/filePosn.c

   1 /*
   2  * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
   3  *
   4  * $Id: filePosn.c,v 1.4 1999/09/19 19:20:50 sof Exp $
   5  *
   6  * hGetPosn and hSetPosn Runtime Support
   7  */
   8
   9 #include "Rts.h"
  10 #include "stgio.h"
  11
  12 StgInt
  13 getFilePosn(ptr)
  14 StgForeignPtr ptr;
  15 {
  16     IOFileObject* fo = (IOFileObject*)ptr;
  17     off_t posn;
  18
  19     while ( (posn = lseek(fo->fd, 0, SEEK_CUR)) == -1) {
  20         if (errno != EINTR) {
  21             cvtErrno();
  22             stdErrno();
  23             return -1;
  24         }
  25     }
  26     if (fo->flags & FILEOBJ_WRITE)  {
  27        posn += fo->bufWPtr;
  28     } else if (fo->flags & FILEOBJ_READ) {
  29        posn -= (fo->bufWPtr - fo->bufRPtr);
  30 #if defined(_WIN32)
  31        if (!(fo->flags & FILEOBJ_BINARY)) {
  32           /* Sigh, to get at the Real file position for files opened
  33              in text mode, we need to scan the read buffer looking for
  34              '\n's, making them count as \r\n (i.e., undoing the work of
  35              read()), since lseek() returns the raw position.
  36           */
  37           int i, j;
  38           i = fo->bufRPtr;
  39           j = fo->bufWPtr;
  40           while (i <= j) {
  41             if (((char*)fo->buf)[i] == '\n') {
  42                posn--;
  43             }
  44             i++;
  45           }
  46        }
  47 #endif
  48     }
  49     return (StgInt)posn;
  50 }
  51
  52 /* The following is only called with a position that we've already visited
  53    (this is ensured by making the Haskell file posn. type abstract.)
  54 */
  55 StgInt
  56 setFilePosn(ptr, size, d)
  57 StgForeignPtr ptr;
  58 StgInt size;
  59 StgByteArray d;
  60 {
  61     IOFileObject* fo = (IOFileObject*)ptr;
  62     int rc, mode;
  63     off_t offset;
  64
  65     /*
  66      * We need to snatch the offset out of an MP_INT.  The bits are there sans sign,
  67      * which we pick up from our size parameter.  If abs(size) is greater than 1,
  68      * this integer is just too big.
  69      */
  70     switch (size) {
  71     case -1:
  72         offset = -*(StgInt *) d;
  73         break;
  74     case 0:
  75         offset = 0;
  76         break;
  77     case 1:
  78         offset = *(StgInt *) d;
  79         break;
  80     default:
  81         ghc_errtype = ERR_INVALIDARGUMENT;
  82         ghc_errstr = "offset out of range";
  83         return -1;
  84     }
  85
  86     rc = flushBuffer(ptr);
  87     if (rc < 0) return rc;
  88
  89     while (lseek(fo->fd, offset, SEEK_SET) == -1) {
  90         if (errno != EINTR) {
  91             cvtErrno();
  92             stdErrno();
  93             return -1;
  94         }
  95     }
  96     FILEOBJ_CLEAR_EOF(fo);
  97     return 0;
  98 }