ghc/lib/std/cbits/readFile.lc

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1994
   3 %
   4 \subsection[readFile.lc]{hGetContents Runtime Support}
   5
   6 \begin{code}
   7
   8 #include "rtsdefs.h"
   9 #include "stgio.h"
  10
  11 #define EOT 4
  12
  13 /* Filling up a (block-buffered) buffer, that
  14    is completely empty. */
  15 StgInt
  16 readBlock(ptr)
  17 StgForeignObj ptr;
  18 {
  19     IOFileObject* fo = (IOFileObject*)ptr;
  20     int count,rc=0;
  21     int fd;
  22
  23     /* Check if someone hasn't zapped us */
  24     if ( fo == NULL || fo->fd == -1 )
  25        return -2;
  26
  27     fd = fo->fd;
  28
  29     if ( FILEOBJ_IS_EOF(fo) ) {
  30         ghc_errtype = ERR_EOF;
  31         ghc_errstr = "";
  32         return -1;
  33     }
  34
  35     /* Weird case: buffering has suddenly been turned off.
  36        Return non-std value and deal with this case on the Haskell side.
  37     */
  38     if ( FILEOBJ_UNBUFFERED(fo) ) {
  39         return -3;
  40     }
  41
  42     /* if input stream is connect to an output stream, flush this one first. */
  43     if ( fo->connectedTo != NULL   &&
  44          fo->connectedTo->fd != -1 &&
  45          (fo->connectedTo->flags & FILEOBJ_WRITE)
  46        ) {
  47        rc = flushFile((StgForeignObj)fo->connectedTo);
  48     }
  49     if (rc < 0) return (rc == FILEOBJ_BLOCKED_WRITE ? FILEOBJ_BLOCKED_CONN_WRITE : rc);
  50
  51     /* RW object: flush the (output) buffer first. */
  52     if ( FILEOBJ_WRITEABLE(fo) && FILEOBJ_JUST_WRITTEN(fo) && FILEOBJ_NEEDS_FLUSHING(fo) ) {
  53         rc = flushBuffer(ptr);
  54         if (rc < 0) return rc;
  55     }
  56     fo->flags = (fo->flags & ~FILEOBJ_RW_WRITE) | FILEOBJ_RW_READ;
  57
  58     /* return the unread parts of the file buffer..*/
  59     if ( fo->flags & FILEOBJ_READ &&
  60          fo->bufRPtr > 0          &&
  61          fo->bufWPtr > fo->bufRPtr ) {
  62         count = fo->bufWPtr - fo->bufRPtr;
  63         fo->bufRPtr=0;
  64         return count;
  65     }
  66
  67 #if 0
  68     fprintf(stderr, "rb: %d %d %d\n", fo->bufRPtr, fo->bufWPtr, fo->bufSize);
  69 #endif
  70
  71     if ( fo->flags & FILEOBJ_NONBLOCKING_IO && inputReady (ptr,0) != 1 )
  72       return FILEOBJ_BLOCKED_READ;
  73
  74     while ((count = read(fd, fo->buf, fo->bufSize)) <= 0) {
  75         if ( count == 0 ) {
  76             FILEOBJ_SET_EOF(fo);
  77             ghc_errtype = ERR_EOF;
  78             ghc_errstr = "";
  79             return -1;
  80         } else if ( count == -1 && errno == EAGAIN) {
  81             errno = 0;
  82             return FILEOBJ_BLOCKED_READ;
  83         } else if ( count == -1 && errno != EINTR) {
  84             cvtErrno();
  85             stdErrno();
  86             return -1;
  87         }
  88     }
  89     fo->bufWPtr = count;
  90     fo->bufRPtr = 0;
  91     return count;
  92 }
  93
  94 /* Filling up a (block-buffered) buffer of length len */
  95 StgInt
  96 readChunk(ptr,buf,len)
  97 StgForeignObj ptr;
  98 StgAddr buf;
  99 StgInt len;
 100 {
 101     IOFileObject* fo = (IOFileObject*)ptr;
 102     int count=0,rc=0, total_count;
 103     int fd;
 104     char* p;
 105
 106     /* Check if someone hasn't zapped us */
 107     if ( fo == NULL )
 108        return -2;
 109
 110     fd = fo->fd;
 111
 112     if ( fd == -1 ) /* File has been closed for us */
 113        return -2;
 114
 115     if ( FILEOBJ_IS_EOF(fo) ) {
 116         ghc_errtype = ERR_EOF;
 117         ghc_errstr = "";
 118         return -1;
 119     }
 120
 121     /* if input stream is connect to an output stream, flush it first */
 122     if ( fo->connectedTo != NULL   &&
 123          fo->connectedTo->fd != -1 &&
 124          (fo->connectedTo->flags & FILEOBJ_WRITE)
 125        ) {
 126        rc = flushFile((StgForeignObj)fo->connectedTo);
 127     }
 128     if (rc < 0) return (rc == FILEOBJ_BLOCKED_WRITE ? FILEOBJ_BLOCKED_CONN_WRITE : rc);
 129
 130     /* RW object: flush the (output) buffer first. */
 131     if ( FILEOBJ_WRITEABLE(fo) && FILEOBJ_JUST_WRITTEN(fo) && FILEOBJ_NEEDS_FLUSHING(fo) ) {
 132         rc = flushBuffer(ptr);
 133         if (rc < 0) return rc;
 134     }
 135     fo->flags = (fo->flags & ~FILEOBJ_RW_WRITE) | FILEOBJ_RW_READ;
 136
 137     /* copy the unread parts of the file buffer..*/
 138     if ( FILEOBJ_READABLE(fo) &&
 139          fo->bufRPtr > 0      &&
 140          fo->bufWPtr >= fo->bufRPtr ) {
 141         count = ( len < (fo->bufWPtr - fo->bufRPtr)) ? len : (fo->bufWPtr - fo->bufRPtr);
 142         memcpy(buf,fo->buf, count);
 143         fo->bufWPtr=0;
 144         fo->bufRPtr=0;
 145
 146     }
 147
 148     if (len - count <= 0)
 149        return count;
 150
 151     len -= count;
 152     p = buf;
 153     p += count;
 154     total_count = count;
 155
 156     if ( fo->flags & FILEOBJ_NONBLOCKING_IO && inputReady (ptr,0) != 1 )
 157       return FILEOBJ_BLOCKED_READ;
 158
 159     while ((count = read(fd, p, len)) < len) {
 160         if ( count == 0 ) { /* EOF */
 161             break;
 162         } else if ( count == -1 && errno == EAGAIN) {
 163             errno = 0;
 164             return FILEOBJ_BLOCKED_READ;
 165         } else if ( count == -1 && errno != EINTR) {
 166             cvtErrno();
 167             stdErrno();
 168             return -1;
 169         }
 170         total_count += count;
 171         len -= count;
 172         p += count;
 173     }
 174
 175     total_count += count;
 176     fo->bufWPtr = total_count;
 177     fo->bufRPtr = 0;
 178     return total_count;
 179 }
 180
 181 /*
 182   readLine() tries to fill the buffer up with a line of chars, returning
 183   the length of the resulting line.
 184
 185   Users of readLine() should immediately afterwards copy out the line
 186   from the buffer.
 187
 188 */
 189
 190 StgInt
 191 readLine(ptr)
 192 StgForeignObj ptr;
 193 {
 194     IOFileObject* fo = (IOFileObject*)ptr;
 195     char *s;
 196     int rc=0, count;
 197
 198     /* Check if someone hasn't zapped us */
 199     if ( fo == NULL || fo->fd == -1 )
 200        return -2;
 201
 202     if ( FILEOBJ_IS_EOF(fo) ) {
 203         ghc_errtype = ERR_EOF;
 204         ghc_errstr = "";
 205         return -1;
 206     }
 207
 208     /* Weird case: buffering has been turned off.
 209        Return non-std value and deal with this case on the Haskell side.
 210     */
 211     if ( FILEOBJ_UNBUFFERED(fo) ) {
 212         return -3;
 213     }
 214
 215     /* if input stream is connect to an output stream, flush it first */
 216     if ( fo->connectedTo != NULL   &&
 217          fo->connectedTo->fd != -1 &&
 218          (fo->connectedTo->flags & FILEOBJ_WRITE)
 219        ) {
 220        rc = flushFile((StgForeignObj)fo->connectedTo);
 221     }
 222     if (rc < 0) return (rc == FILEOBJ_BLOCKED_WRITE ? FILEOBJ_BLOCKED_CONN_WRITE : rc);
 223
 224     /* RW object: flush the (output) buffer first. */
 225     if ( FILEOBJ_WRITEABLE(fo) && FILEOBJ_JUST_WRITTEN(fo) ) {
 226         rc = flushBuffer(ptr);
 227         if (rc < 0) return rc;
 228     }
 229     fo->flags = (fo->flags & ~FILEOBJ_RW_WRITE) | FILEOBJ_RW_READ;
 230
 231     if ( fo->bufRPtr < 0 || fo->bufRPtr >= fo->bufWPtr ) { /* Buffer is empty */
 232        fo->bufRPtr=0; fo->bufWPtr=0;
 233        rc = fill_up_line_buffer(fo);
 234        if (rc < 0) return rc;
 235     }
 236
 237     while (1) {
 238        unsigned char* s1 = memchr((unsigned char *)fo->buf+fo->bufRPtr, '\n', fo->bufWPtr - fo->bufRPtr);
 239        if (s1 != NULL ) {  /* Found one */
 240           /* Note: we *don't* zero terminate the line */
 241           count = s1 - ((unsigned char*)fo->buf + fo->bufRPtr) + 1;
 242           fo->bufRPtr += count;
 243           return count;
 244        } else {
 245           /* Just return partial line */
 246           count = fo->bufWPtr - fo->bufRPtr;
 247           fo->bufRPtr += count;
 248           return count;
 249        }
 250     }
 251
 252 }
 253
 254 StgInt
 255 readChar(ptr)
 256 StgForeignObj ptr;
 257 {
 258     IOFileObject* fo= (IOFileObject*)ptr;
 259     int count,rc=0;
 260     char c;
 261
 262     /* Check if someone hasn't zapped us */
 263     if ( fo == NULL || fo->fd == -1)
 264        return -2;
 265
 266     if ( FILEOBJ_IS_EOF(fo) ) {
 267         ghc_errtype = ERR_EOF;
 268         ghc_errstr = "";
 269         return -1;
 270     }
 271
 272     /* Buffering has been changed, report back */
 273     if ( FILEOBJ_LINEBUFFERED(fo) ) {
 274        return -3;
 275     } else if ( FILEOBJ_BLOCKBUFFERED(fo) ) {
 276        return -4;
 277     }
 278
 279     /* if input stream is connect to an output stream, flush it first */
 280     if ( fo->connectedTo != NULL   &&
 281          fo->connectedTo->fd != -1 &&
 282          (fo->connectedTo->flags & FILEOBJ_WRITE)
 283        ) {
 284        rc = flushFile((StgForeignObj)fo->connectedTo);
 285     }
 286     if (rc < 0) return (rc == FILEOBJ_BLOCKED_WRITE ? FILEOBJ_BLOCKED_CONN_WRITE : rc);
 287
 288     /* RW object: flush the (output) buffer first. */
 289     if ( FILEOBJ_WRITEABLE(fo) && FILEOBJ_JUST_WRITTEN(fo) && FILEOBJ_NEEDS_FLUSHING(fo) ) {
 290         rc = flushBuffer(ptr);
 291         if (rc < 0) return rc;
 292     }
 293     fo->flags = (fo->flags & ~FILEOBJ_RW_WRITE) | FILEOBJ_RW_READ;
 294
 295     if ( fo->flags & FILEOBJ_NONBLOCKING_IO && inputReady (ptr,0) != 1 )
 296       return FILEOBJ_BLOCKED_READ;
 297
 298     while ( (count = read(fo->fd, &c, 1)) <= 0 ) {
 299         if ( count == 0 ) {
 300             ghc_errtype = ERR_EOF;
 301             ghc_errstr = "";
 302             return -1;
 303         } else if ( count == -1 && errno == EAGAIN) {
 304             errno = 0;
 305             return FILEOBJ_BLOCKED_READ;
 306         } else if ( count == -1 && errno != EINTR) {
 307             cvtErrno();
 308             stdErrno();
 309             return -1;
 310         }
 311     }
 312
 313     if ( isatty(fo->fd) && c == EOT ) {
 314         return EOF;
 315     } else {
 316         return (int)c;
 317     }
 318 }
 319
 320 \end{code}