ghc/lib/std/cbits/fileObject.c

   1 /*
   2  * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
   3  *
   4  * $Id: fileObject.c,v 1.11 2000/10/10 09:28:50 simonmar Exp $
   5  *
   6  * hPutStr Runtime Support
   7  */
   8
   9 #include "Rts.h"
  10 #include "stgio.h"
  11
  12 #include <stdio.h>
  13
  14 #if defined(HAVE_WINSOCK_H) && !defined(__CYGWIN__) && !defined(__CYGWIN32__)
  15 #define USE_WINSOCK
  16 #endif
  17
  18 #ifdef USE_WINSOCK
  19 #include <winsock.h>
  20 #endif
  21
  22 void
  23 setBufFlags(StgForeignPtr fo, StgInt flg)
  24 {
  25   ((IOFileObject*)fo)->flags = flg;
  26   return;
  27 }
  28
  29 void
  30 setBufWPtr(StgForeignPtr fo, StgInt len)
  31 {
  32   ((IOFileObject*)fo)->bufWPtr = len;
  33   return;
  34 }
  35
  36 StgInt
  37 getBufWPtr(StgForeignPtr fo)
  38 {
  39   return (((IOFileObject*)fo)->bufWPtr);
  40 }
  41
  42 StgInt
  43 getBufSize(StgForeignPtr fo)
  44 {
  45   return (((IOFileObject*)fo)->bufSize);
  46 }
  47
  48 void
  49 setBuf(StgForeignPtr fo, StgAddr buf,StgInt sz)
  50 {
  51   ((IOFileObject*)fo)->buf     = buf;
  52   ((IOFileObject*)fo)->bufSize = sz;
  53   return;
  54 }
  55
  56 StgAddr
  57 getBuf(StgForeignPtr fo)
  58 { return (((IOFileObject*)fo)->buf); }
  59
  60 StgAddr
  61 getWriteableBuf(StgForeignPtr ptr)
  62 {
  63    /* getWriteableBuf() is called prior to starting to pack
  64       a Haskell string into the IOFileObject buffer. It takes
  65       care of flushing the (input) buffer in the case we're
  66       dealing with a RW handle.
  67    */
  68    IOFileObject* fo = (IOFileObject*)ptr;
  69
  70    if ( FILEOBJ_READABLE(fo) && FILEOBJ_JUST_READ(fo) ) {
  71       flushReadBuffer(ptr);  /* ignoring return code */
  72       /* Ahead of time really, but indicate that we're (just about to) write */
  73    }
  74    fo->flags = (fo->flags & ~FILEOBJ_RW_READ) | FILEOBJ_RW_WRITE;
  75    return (fo->buf);
  76 }
  77
  78 StgAddr
  79 getBufStart(StgForeignPtr fo, StgInt count)
  80 { return ((char*)((IOFileObject*)fo)->buf + (((IOFileObject*)fo)->bufRPtr) - count); }
  81
  82 StgInt
  83 getFileFd(StgForeignPtr fo)
  84 { return (((IOFileObject*)fo)->fd); }
  85
  86 StgInt
  87 getConnFileFd(StgForeignPtr fo)
  88 { return (((IOFileObject*)fo)->connectedTo->fd); }
  89
  90
  91 void
  92 setFd(StgForeignPtr fo,StgInt fp)
  93 { ((IOFileObject*)fo)->fd = fp;
  94   return;
  95 }
  96
  97 void
  98 setConnectedTo(StgForeignPtr fo, StgForeignPtr fw, StgInt flg)
  99 {
 100   if( flg && (! isatty(((IOFileObject*)fo)->fd) || !isatty(((IOFileObject*)fw)->fd)) ) {
 101       return;
 102   }
 103  ((IOFileObject*)fo)->connectedTo = (IOFileObject*)fw;
 104   return;
 105 }
 106
 107 static int __pushback_buf_size__ = 2;
 108
 109 void
 110 setPushbackBufSize(StgInt i)
 111 { __pushback_buf_size__ = (i > 0 ? i : 0); }
 112
 113 StgInt
 114 getPushbackBufSize(void)
 115 { return (__pushback_buf_size__); }
 116
 117 /* Only ever called on line-buffered file objects */
 118 StgInt
 119 fill_up_line_buffer(IOFileObject* fo)
 120 {
 121   int count,len, ipos;
 122   unsigned char* p;
 123
 124   /* ToDo: deal with buffer overflow (i.e., realloc buffer if this happens) */
 125
 126   if ( fo->bufRPtr == fo->bufWPtr ) { /* There's nothing in the buffer, reset */
 127       fo->bufRPtr=0;
 128       fo->bufWPtr=0;
 129   }
 130   ipos = fo->bufWPtr;
 131   len = fo->bufSize - fo->bufWPtr;
 132   p   = (unsigned char*)fo->buf + fo->bufWPtr;
 133
 134   while ((count =
 135          (
 136 #ifdef USE_WINSOCK
 137            fo->flags & FILEOBJ_WINSOCK ?
 138            recv(fo->fd, p, len, 0) :
 139            read(fo->fd, p, len))) <= 0 ) {
 140 #else
 141            read(fo->fd, p, len))) <= 0 ) {
 142 #endif
 143       if (count == 0) {
 144          ghc_errtype = ERR_EOF;
 145          ghc_errstr = "";
 146          FILEOBJ_SET_EOF(fo);
 147          return -1;
 148       } else if ( count == -1 && errno == EAGAIN) {
 149          errno = 0;
 150          return FILEOBJ_BLOCKED_READ;
 151       } else if ( count == -1 && errno != EINTR ) {
 152          cvtErrno();
 153          stdErrno();
 154          return -1;
 155       }
 156   }
 157   fo->bufWPtr += count;
 158 /* TODO: ipos doesn't change???? what's it for??? --SDM */
 159   return (fo->bufWPtr - ipos);
 160 }