ghc/lib/std/cbits/filePosn.c

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