summaryrefslogtreecommitdiff
path: root/ghc/lib/std/cbits/readFile.c
diff options
context:
space:
mode:
Diffstat (limited to 'ghc/lib/std/cbits/readFile.c')
-rw-r--r--ghc/lib/std/cbits/readFile.c319
1 files changed, 319 insertions, 0 deletions
diff --git a/ghc/lib/std/cbits/readFile.c b/ghc/lib/std/cbits/readFile.c
new file mode 100644
index 0000000000..fa6aa87dd8
--- /dev/null
+++ b/ghc/lib/std/cbits/readFile.c
@@ -0,0 +1,319 @@
+/*
+ * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
+ *
+ * $Id: readFile.c,v 1.3 1998/12/02 13:27:45 simonm Exp $
+ *
+ * hGetContents Runtime Support
+ */
+
+#include "Rts.h"
+#include "stgio.h"
+
+#define EOT 4
+
+/* Filling up a (block-buffered) buffer, that
+ is completely empty. */
+StgInt
+readBlock(ptr)
+StgForeignPtr ptr;
+{
+ IOFileObject* fo = (IOFileObject*)ptr;
+ int count,rc=0;
+ int fd;
+
+ /* Check if someone hasn't zapped us */
+ if ( fo == NULL || fo->fd == -1 )
+ return -2;
+
+ fd = fo->fd;
+
+ if ( FILEOBJ_IS_EOF(fo) ) {
+ ghc_errtype = ERR_EOF;
+ ghc_errstr = "";
+ return -1;
+ }
+
+ /* Weird case: buffering has suddenly been turned off.
+ Return non-std value and deal with this case on the Haskell side.
+ */
+ if ( FILEOBJ_UNBUFFERED(fo) ) {
+ return -3;
+ }
+
+ /* if input stream is connect to an output stream, flush this one first. */
+ if ( fo->connectedTo != NULL &&
+ fo->connectedTo->fd != -1 &&
+ (fo->connectedTo->flags & FILEOBJ_WRITE)
+ ) {
+ rc = flushFile((StgForeignPtr)fo->connectedTo);
+ }
+ if (rc < 0) return (rc == FILEOBJ_BLOCKED_WRITE ? FILEOBJ_BLOCKED_CONN_WRITE : rc);
+
+ /* RW object: flush the (output) buffer first. */
+ if ( FILEOBJ_WRITEABLE(fo) && FILEOBJ_JUST_WRITTEN(fo) && FILEOBJ_NEEDS_FLUSHING(fo) ) {
+ rc = flushBuffer(ptr);
+ if (rc < 0) return rc;
+ }
+ fo->flags = (fo->flags & ~FILEOBJ_RW_WRITE) | FILEOBJ_RW_READ;
+
+ /* return the unread parts of the file buffer..*/
+ if ( fo->flags & FILEOBJ_READ &&
+ fo->bufRPtr > 0 &&
+ fo->bufWPtr > fo->bufRPtr ) {
+ count = fo->bufWPtr - fo->bufRPtr;
+ fo->bufRPtr=0;
+ return count;
+ }
+
+#if 0
+ fprintf(stderr, "rb: %d %d %d\n", fo->bufRPtr, fo->bufWPtr, fo->bufSize);
+#endif
+
+ if ( fo->flags & FILEOBJ_NONBLOCKING_IO && inputReady (ptr,0) != 1 )
+ return FILEOBJ_BLOCKED_READ;
+
+ while ((count = read(fd, fo->buf, fo->bufSize)) <= 0) {
+ if ( count == 0 ) {
+ FILEOBJ_SET_EOF(fo);
+ ghc_errtype = ERR_EOF;
+ ghc_errstr = "";
+ return -1;
+ } else if ( count == -1 && errno == EAGAIN) {
+ errno = 0;
+ return FILEOBJ_BLOCKED_READ;
+ } else if ( count == -1 && errno != EINTR) {
+ cvtErrno();
+ stdErrno();
+ return -1;
+ }
+ }
+ fo->bufWPtr = count;
+ fo->bufRPtr = 0;
+ return count;
+}
+
+/* Filling up a (block-buffered) buffer of length len */
+StgInt
+readChunk(ptr,buf,len)
+StgForeignPtr ptr;
+StgAddr buf;
+StgInt len;
+{
+ IOFileObject* fo = (IOFileObject*)ptr;
+ int count=0,rc=0, total_count;
+ int fd;
+ char* p;
+
+ /* Check if someone hasn't zapped us */
+ if ( fo == NULL )
+ return -2;
+
+ fd = fo->fd;
+
+ if ( fd == -1 ) /* File has been closed for us */
+ return -2;
+
+ if ( FILEOBJ_IS_EOF(fo) ) {
+ ghc_errtype = ERR_EOF;
+ ghc_errstr = "";
+ return -1;
+ }
+
+ /* if input stream is connect to an output stream, flush it first */
+ if ( fo->connectedTo != NULL &&
+ fo->connectedTo->fd != -1 &&
+ (fo->connectedTo->flags & FILEOBJ_WRITE)
+ ) {
+ rc = flushFile((StgForeignPtr)fo->connectedTo);
+ }
+ if (rc < 0) return (rc == FILEOBJ_BLOCKED_WRITE ? FILEOBJ_BLOCKED_CONN_WRITE : rc);
+
+ /* RW object: flush the (output) buffer first. */
+ if ( FILEOBJ_WRITEABLE(fo) && FILEOBJ_JUST_WRITTEN(fo) && FILEOBJ_NEEDS_FLUSHING(fo) ) {
+ rc = flushBuffer(ptr);
+ if (rc < 0) return rc;
+ }
+ fo->flags = (fo->flags & ~FILEOBJ_RW_WRITE) | FILEOBJ_RW_READ;
+
+ /* copy the unread parts of the file buffer..*/
+ if ( FILEOBJ_READABLE(fo) &&
+ fo->bufRPtr > 0 &&
+ fo->bufWPtr >= fo->bufRPtr ) {
+ count = ( len < (fo->bufWPtr - fo->bufRPtr)) ? len : (fo->bufWPtr - fo->bufRPtr);
+ memcpy(buf,fo->buf, count);
+ fo->bufWPtr=0;
+ fo->bufRPtr=0;
+
+ }
+
+ if (len - count <= 0)
+ return count;
+
+ len -= count;
+ p = buf;
+ p += count;
+ total_count = count;
+
+ if ( fo->flags & FILEOBJ_NONBLOCKING_IO && inputReady (ptr,0) != 1 )
+ return FILEOBJ_BLOCKED_READ;
+
+ while ((count = read(fd, p, len)) < len) {
+ if ( count == 0 ) { /* EOF */
+ break;
+ } else if ( count == -1 && errno == EAGAIN) {
+ errno = 0;
+ return FILEOBJ_BLOCKED_READ;
+ } else if ( count == -1 && errno != EINTR) {
+ cvtErrno();
+ stdErrno();
+ return -1;
+ }
+ total_count += count;
+ len -= count;
+ p += count;
+ }
+
+ total_count += count;
+ fo->bufWPtr = total_count;
+ fo->bufRPtr = 0;
+ return total_count;
+}
+
+/*
+ readLine() tries to fill the buffer up with a line of chars, returning
+ the length of the resulting line.
+
+ Users of readLine() should immediately afterwards copy out the line
+ from the buffer.
+
+*/
+
+StgInt
+readLine(ptr)
+StgForeignPtr ptr;
+{
+ IOFileObject* fo = (IOFileObject*)ptr;
+ char *s;
+ int rc=0, count;
+
+ /* Check if someone hasn't zapped us */
+ if ( fo == NULL || fo->fd == -1 )
+ return -2;
+
+ if ( FILEOBJ_IS_EOF(fo) ) {
+ ghc_errtype = ERR_EOF;
+ ghc_errstr = "";
+ return -1;
+ }
+
+ /* Weird case: buffering has been turned off.
+ Return non-std value and deal with this case on the Haskell side.
+ */
+ if ( FILEOBJ_UNBUFFERED(fo) ) {
+ return -3;
+ }
+
+ /* if input stream is connect to an output stream, flush it first */
+ if ( fo->connectedTo != NULL &&
+ fo->connectedTo->fd != -1 &&
+ (fo->connectedTo->flags & FILEOBJ_WRITE)
+ ) {
+ rc = flushFile((StgForeignPtr)fo->connectedTo);
+ }
+ if (rc < 0) return (rc == FILEOBJ_BLOCKED_WRITE ? FILEOBJ_BLOCKED_CONN_WRITE : rc);
+
+ /* RW object: flush the (output) buffer first. */
+ if ( FILEOBJ_WRITEABLE(fo) && FILEOBJ_JUST_WRITTEN(fo) ) {
+ rc = flushBuffer(ptr);
+ if (rc < 0) return rc;
+ }
+ fo->flags = (fo->flags & ~FILEOBJ_RW_WRITE) | FILEOBJ_RW_READ;
+
+ if ( fo->bufRPtr < 0 || fo->bufRPtr >= fo->bufWPtr ) { /* Buffer is empty */
+ fo->bufRPtr=0; fo->bufWPtr=0;
+ rc = fill_up_line_buffer(fo);
+ if (rc < 0) return rc;
+ }
+
+ while (1) {
+ unsigned char* s1 = memchr((unsigned char *)fo->buf+fo->bufRPtr, '\n', fo->bufWPtr - fo->bufRPtr);
+ if (s1 != NULL ) { /* Found one */
+ /* Note: we *don't* zero terminate the line */
+ count = s1 - ((unsigned char*)fo->buf + fo->bufRPtr) + 1;
+ fo->bufRPtr += count;
+ return count;
+ } else {
+ /* Just return partial line */
+ count = fo->bufWPtr - fo->bufRPtr;
+ fo->bufRPtr += count;
+ return count;
+ }
+ }
+
+}
+
+StgInt
+readChar(ptr)
+StgForeignPtr ptr;
+{
+ IOFileObject* fo= (IOFileObject*)ptr;
+ int count,rc=0;
+ char c;
+
+ /* Check if someone hasn't zapped us */
+ if ( fo == NULL || fo->fd == -1)
+ return -2;
+
+ if ( FILEOBJ_IS_EOF(fo) ) {
+ ghc_errtype = ERR_EOF;
+ ghc_errstr = "";
+ return -1;
+ }
+
+ /* Buffering has been changed, report back */
+ if ( FILEOBJ_LINEBUFFERED(fo) ) {
+ return -3;
+ } else if ( FILEOBJ_BLOCKBUFFERED(fo) ) {
+ return -4;
+ }
+
+ /* if input stream is connect to an output stream, flush it first */
+ if ( fo->connectedTo != NULL &&
+ fo->connectedTo->fd != -1 &&
+ (fo->connectedTo->flags & FILEOBJ_WRITE)
+ ) {
+ rc = flushFile((StgForeignPtr)fo->connectedTo);
+ }
+ if (rc < 0) return (rc == FILEOBJ_BLOCKED_WRITE ? FILEOBJ_BLOCKED_CONN_WRITE : rc);
+
+ /* RW object: flush the (output) buffer first. */
+ if ( FILEOBJ_WRITEABLE(fo) && FILEOBJ_JUST_WRITTEN(fo) && FILEOBJ_NEEDS_FLUSHING(fo) ) {
+ rc = flushBuffer(ptr);
+ if (rc < 0) return rc;
+ }
+ fo->flags = (fo->flags & ~FILEOBJ_RW_WRITE) | FILEOBJ_RW_READ;
+
+ if ( fo->flags & FILEOBJ_NONBLOCKING_IO && inputReady (ptr,0) != 1 )
+ return FILEOBJ_BLOCKED_READ;
+
+ while ( (count = read(fo->fd, &c, 1)) <= 0 ) {
+ if ( count == 0 ) {
+ ghc_errtype = ERR_EOF;
+ ghc_errstr = "";
+ return -1;
+ } else if ( count == -1 && errno == EAGAIN) {
+ errno = 0;
+ return FILEOBJ_BLOCKED_READ;
+ } else if ( count == -1 && errno != EINTR) {
+ cvtErrno();
+ stdErrno();
+ return -1;
+ }
+ }
+
+ if ( isatty(fo->fd) && c == EOT ) {
+ return EOF;
+ } else {
+ return (int)c;
+ }
+}
View Lorry Controller Status