--- /dev/null
+%
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1998
+%
+\subsection[allocMem.lc]{Allocating memory off heap}
+
+\begin{code}
+
+#include "rtsdefs.h"
+#include "stgio.h"
+
+StgAddr
+allocMemory__(sz)
+StgInt sz;/* bytes*/
+{
+ StgAddr ptr;
+
+ if ( (ptr = malloc(sz*sizeof(char))) == NULL) {
+ ghc_errtype = ERR_RESOURCEEXHAUSTED;
+ ghc_errstr = "malloc failed";
+ return NULL;
+ }
+ return ptr;
+
+}
+
+\end{code}
#include "rtsdefs.h"
#include "stgio.h"
+StgInt __really_close_stdfiles=1;
+
StgInt
-closeFile(fp)
-StgForeignObj fp;
+closeFile(ptr,flush_buf)
+StgForeignObj ptr;
+StgInt flush_buf;
{
- int rc;
+ IOFileObject* fo = (IOFileObject*)ptr;
+ int rc = 0;
int unlocked=1;
- if ( unlockFile(fileno((FILE *) fp)) ) {
+ /* Already closed, shouldn't occur. */
+ if ( fo == NULL ) {
+ return 0;
+ }
+
+ if ( flush_buf != 0 && (fo->flags & FILEOBJ_FLUSH) ) {
+ writeFileObject(ptr,fo->bufWPtr);
+ }
+
+ /* If the flush failed, we ignore this and soldier on.. */
+
+ if ( unlockFile(fo->fd) ) {
/* If the file has already been unlocked (or an entry
for it in the locking tables couldn't be found), could
mean two things:
(file descriptors to non regular files.)
We proceed with attempting to close the file,
- but don't flag the error should fclose() return
+ but don't flag the error should close() return
EBADF
*/
unlocked=0;
}
- while ((rc = fclose((FILE *) fp)) != 0) {
- /* See above comment */
- if ( errno != EINTR && (!unlocked && errno != EBADF ) ) {
+ /* Closing file descriptors that refer to standard channels
+ is problematic, so we back off from doing this by default,
+ just closing them at the Handle level. If you insist on
+ closing them, setting the (global) variable
+ __really_close_stdfiles to 0 turns off this behaviour.
+ */
+ if ( (fo->flags & FILEOBJ_STD) && __really_close_stdfiles ) {
+ ;
+
+ } else {
+ /* Regardless of success or otherwise, the fd field gets smashed. */
+ while ( (rc = close(fo->fd)) != 0 ) {
+ /* See above unlockFile() comment */
+ if ( errno != EINTR && (!unlocked && errno != EBADF ) ) {
cvtErrno();
stdErrno();
+ fo->fd = -1;
return rc;
}
+ }
}
+ fo->fd = -1;
return 0;
}
\end{code}
-
-
-
#endif
StgInt
-setTerminalEcho(fp, on)
-StgForeignObj fp;
+setTerminalEcho(ptr, on)
+StgForeignObj ptr;
StgInt on;
{
+ IOFileObject* fo = (IOFileObject*)ptr;
struct termios tios;
int fd, rc;
- while ( (fd = fileno((FILE*)fp)) < 0) {
- if (errno != EINTR) {
- cvtErrno();
- stdErrno();
- return -1;
- }
- }
+ fd = fo->fd;
+
while ( (rc = tcgetattr(fd,&tios)) == -1) {
if (errno != EINTR) {
cvtErrno();
}
StgInt
-getTerminalEcho(fp)
-StgForeignObj fp;
+getTerminalEcho(ptr)
+StgForeignObj ptr;
{
+ IOFileObject* fo = (IOFileObject*)ptr;
struct termios tios;
int fd, rc;
- while ( (fd = fileno((FILE*)fp)) < 0) {
- if (errno != EINTR) {
- cvtErrno();
- stdErrno();
- return -1;
- }
- }
+ fd = fo->fd;
+
while ( (rc = tcgetattr(fd,&tios)) == -1) {
if (errno != EINTR) {
cvtErrno();
}
StgInt
-isTerminalDevice(fp)
-StgForeignObj fp;
+isTerminalDevice(ptr)
+StgForeignObj ptr;
{
+ IOFileObject* fo = (IOFileObject*)ptr;
struct termios tios;
int fd, rc;
- while ( (fd = fileno((FILE*)fp)) < 0) {
- if (errno != EINTR) {
- cvtErrno();
- stdErrno();
- return -1;
- }
- }
+ fd = fo -> fd;
+
while ( (rc = tcgetattr(fd,&tios)) == -1) {
if (errno == ENOTTY) return 0;
if (errno != EINTR) {
char *ghc_errstr = NULL;
+StgAddr
+getErrStr__()
+{ return ((StgAddr)ghc_errstr); }
+
+StgInt
+getErrNo__()
+{ return ((StgInt)ghc_errno); }
+
+StgInt
+getErrType__()
+{ return ((StgInt)ghc_errtype); }
+
+
/* Collect all of the grotty #ifdef's in one place. */
void cvtErrno(STG_NO_ARGS)
#include "stgio.h"
StgInt
-fileEOF(fp)
-StgForeignObj fp;
+fileEOF(ptr)
+StgForeignObj ptr;
{
- if (fileLookAhead(fp) != EOF)
+ IOFileObject* fo = (IOFileObject*)ptr;
+
+ if ( FILEOBJ_IS_EOF(fo) )
+ return 1;
+
+ if (fileLookAhead(ptr) != EOF)
return 0;
else if (ghc_errtype == ERR_EOF)
return 1;
#include "stgio.h"
#include "error.h"
+#define EOT 4
+
+/* Pre-condition: only ever called on a readable fileObject */
StgInt
-fileGetc(fp)
-StgForeignObj fp;
+fileGetc(ptr)
+StgForeignObj ptr;
{
- int c;
+ IOFileObject* fo = (IOFileObject*)ptr;
+ int l,rc=0;
+ unsigned char c;
+
+#if 0
+ fprintf(stderr, "fgc: %d %d %d\n", fo->bufRPtr, fo->bufWPtr, fo->flags);
+#endif
+ /*
+ fileGetc does the following:
+ - if the input is buffered, try fetch the char from buffer.
+ - failing that,
+
+ - if the input stream is 'connected' to an output stream,
+ flush it before requesting any input.
+ - if unbuffered, read in one character.
+ - if line-buffered, read in one line, returning the first.
+ - if block-buffered, fill up block, returning the first.
+ */
- if (feof((FILE *) fp)) {
- ghc_errtype = ERR_EOF;
- ghc_errstr = "";
- return EOF;
+ if ( FILEOBJ_WRITEABLE(fo) && FILEOBJ_JUST_WRITTEN(fo) && FILEOBJ_NEEDS_FLUSHING(fo) ) {
+ rc = flushBuffer(ptr);
+ if (rc < 0) return rc;
}
- /* Try to read a character */
- while ((c = getc((FILE *) fp)) == EOF && errno == EINTR)
- clearerr((FILE *) fp);
+ fo->flags = (fo->flags & ~FILEOBJ_RW_WRITE) | FILEOBJ_RW_READ;
- if (feof((FILE *) fp)) {
+ if ( FILEOBJ_IS_EOF(fo) ) {
ghc_errtype = ERR_EOF;
ghc_errstr = "";
- } else if (c == EOF) {
- cvtErrno();
- stdErrno();
+ return -1;
+ }
+
+ if ( FILEOBJ_BUFFER_EMPTY(fo) ) {
+ ;
+ } else if ( FILEOBJ_UNBUFFERED(fo) && !FILEOBJ_HAS_PUSHBACKS(fo) ) {
+ ;
+ } else if ( FILEOBJ_UNBUFFERED(fo) ) { /* Unbuffered stream has pushbacks, retrieve them */
+ c=((unsigned char*)(fo->buf))[fo->bufRPtr++];
+ return (int)c;
+ } else {
+ c=((unsigned char*)(fo->buf))[fo->bufRPtr];
+ fo->bufRPtr++;
+ return (int)c;
+ }
+
+ /* Nothing in the buffer, go out and fetch a byte for our customer,
+ filling up the buffer if needs be.
+ */
+ if ( FILEOBJ_UNBUFFERED(fo) ) {
+ return (readChar(ptr));
+ } else if ( FILEOBJ_LINEBUFFERED(fo) ) {
+
+ /* 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((StgForeignObj)fo->connectedTo);
+ }
+ if (rc < 0) return rc;
+
+ rc = fill_up_line_buffer(fo);
+ if (rc < 0) return rc;
+
+ c=((unsigned char*)(fo->buf))[fo->bufRPtr];
+ fo->bufRPtr++;
+ return (int)c;
+
+ } else { /* Fully-buffered */
+ rc = readBlock(ptr);
+ if (rc < 0) return rc;
+
+ c=((unsigned char*)(fo->buf))[fo->bufRPtr];
+ fo->bufRPtr++;
+ return (int)c;
}
- return c;
}
\end{code}
#include "stgio.h"
StgInt
-fileLookAhead(fp)
-StgForeignObj fp;
+fileLookAhead(ptr)
+StgForeignObj ptr;
{
- int c;
-
- if ((c = fileGetc(fp)) == EOF) {
- return c;
- } else if (ungetc(c, (FILE *) fp) == EOF) {
- cvtErrno();
- stdErrno();
- return EOF;
- } else
- return c;
+ IOFileObject* fo = (IOFileObject*)ptr;
+ int c, rc;
+
+#if 0
+ fprintf(stderr, "flh: %d %d %d\n",fo->bufRPtr, fo->bufWPtr, fo->flags);
+#endif
+
+ /*
+ * fileLookahead reads the next character (hopefully from the buffer),
+ * before putting it back and returning the char.
+ *
+ */
+
+ if ( FILEOBJ_IS_EOF(fo) ) {
+ ghc_errtype = ERR_EOF;
+ ghc_errstr = "";
+ return -1;
+ }
+
+ if ( (c = fileGetc(ptr)) < 0 ) {
+ return c;
+ }
+
+ rc = ungetChar(ptr,c);
+ if ( rc < 0 ) {
+ return rc;
+ } else {
+ return c;
+ }
}
+StgInt
+ungetChar(ptr,c)
+StgForeignObj ptr;
+StgInt c;
+{
+ IOFileObject* fo = (IOFileObject*)ptr;
+ int rc = 0, sz = 0;
+
+#if 0
+ fprintf(stderr, "ug: %d %d %c\n",fo->bufRPtr, fo->bufWPtr,(char)c, fo->flags);
+#endif
+
+ /* Sanity check */
+ if ( !FILEOBJ_READABLE(fo) ) {
+ ghc_errno = GHC_EINVAL;
+ ghc_errstr = "object not readable";
+ return -1;
+ }
+
+ /* For an unbuffered file object, we lazily
+ allocate a pushback buffer. The sizeof the pushback
+ buffer is (globally) configurable.
+ */
+ sz = getPushbackBufSize();
+ if ( FILEOBJ_UNBUFFERED(fo) && fo->buf==NULL && sz > 0 ) {
+ if ((fo->buf = malloc(sz*sizeof(char))) == NULL ) {
+ return -1;
+ }
+ fo->bufSize = sz;
+ ((unsigned char*)fo->buf)[sz-1]=(unsigned char)c;
+ fo->bufWPtr = sz; /* Points one past the end of pushback buffer */
+ fo->bufRPtr = sz-1; /* points to current char. */
+ return 0;
+ }
+
+ if ( fo->bufWPtr > 0 && fo->bufRPtr > 0 ) {
+ fo->bufRPtr -= 1;
+ ((unsigned char*)fo->buf)[fo->bufRPtr]=(unsigned char)c;
+ return 0;
+ } else if ( fo->buf != NULL &&
+ fo->bufSize > 0 &&
+ fo->bufWPtr == 0 &&
+ fo->bufRPtr==0 ) { /* empty buffer waiting to be filled up */
+ fo->bufRPtr=fo->bufSize-1;
+ ((unsigned char*)fo->buf)[fo->bufRPtr]=(unsigned char)c;
+ fo->bufWPtr=fo->bufSize;
+ return 0;
+ } else {
+ return -1;
+ }
+}
\end{code}
--- /dev/null
+#ifndef FILEOBJECT_H
+#define FILEOBJECT_H
+
+/* a good idea? */
+#include <stdio.h>
+
+/*
+ IOFileObjects are used as part of the IO.Handle
+ implementation, ensuring that when handles are
+ finalised, buffers are flushed and FILE* objects
+ are closed (we really should be using file descriptors
+ here..)
+
+ */
+
+typedef struct _IOFileObject {
+ int fd;
+ void* buf;
+ int bufWPtr; /* points to next position to write,
+ bufRPtr >= bufWPtr <= bufSize.
+
+ For read-only files, bufWPtr = bufSize
+
+ bufWPtr = 0 => buffer is empty.
+
+ */
+ int bufRPtr; /* points to the next char to read
+ -1 >= bufRPtr <= bufWPtr
+
+ For write-only files, bufRPtr = 0
+
+ bufRPtr == -1 => buffer is empty.
+ */
+ int bufSize;
+ int flags;
+ struct _IOFileObject* connectedTo;
+} IOFileObject;
+
+#define FILEOBJ_FLUSH 1
+#define FILEOBJ_LB 2
+#define FILEOBJ_BB 4
+#define FILEOBJ_EOF 8
+#define FILEOBJ_READ 16
+#define FILEOBJ_WRITE 32
+#define FILEOBJ_STD 64
+#define FILEOBJ_NONBLOCKING_IO 128
+/* The next two flags are used for RW file objects only.
+ They indicate whether the last operation was a read or a write.
+ (Need this info to determine whether a RW file object's
+ buffer should be flushed before doing a subsequent
+ read or write).
+*/
+#define FILEOBJ_RW_READ 256
+#define FILEOBJ_RW_WRITE 512
+
+#define FILEOBJ_IS_EOF(x) ((x)->flags & FILEOBJ_EOF)
+#define FILEOBJ_SET_EOF(x) ((x)->flags |= FILEOBJ_EOF)
+#define FILEOBJ_CLEAR_EOF(x) ((x)->flags &= ~FILEOBJ_EOF)
+#define FILEOBJ_CLEAR_ERR(x) FILEOBJ_CLEAR_EOF(x)
+
+#define FILEOBJ_BLOCKED_READ -5
+#define FILEOBJ_BLOCKED_WRITE -6
+#define FILEOBJ_BLOCKED_CONN_WRITE -7
+
+#define FILEOBJ_UNBUFFERED(x) (!((x)->flags & FILEOBJ_LB) && !((x)->flags & FILEOBJ_BB))
+#define FILEOBJ_LINEBUFFERED(x) ((x)->flags & FILEOBJ_LB)
+#define FILEOBJ_BLOCKBUFFERED(x) ((x)->flags & FILEOBJ_BB)
+#define FILEOBJ_BUFFER_FULL(x) ((x)->bufWPtr >= (x)->bufSize)
+#define FILEOBJ_BUFFER_EMPTY(x) ((x)->bufRPtr == (x)->bufWPtr)
+#define FILEOBJ_HAS_PUSHBACKS(x) ((x)->buf != NULL && (x)->bufRPtr >= 0 && (x)->bufRPtr < (x)->bufWPtr)
+#define FILEOBJ_READABLE(x) ((x)->flags & FILEOBJ_READ)
+#define FILEOBJ_WRITEABLE(x) ((x)->flags & FILEOBJ_WRITE)
+#define FILEOBJ_JUST_READ(x) ((x)->flags & FILEOBJ_RW_READ)
+#define FILEOBJ_JUST_WRITTEN(x) ((x)->flags & FILEOBJ_RW_WRITE)
+#define FILEOBJ_NEEDS_FLUSHING(x) (!FILEOBJ_BUFFER_EMPTY(x))
+#define FILEOBJ_RW(x) (FILEOBJ_READABLE(x) && FILEOBJ_WRITEABLE(x))
+
+#endif /* FILEOBJECT_H */
--- /dev/null
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1998
+%
+\subsection[fileObject.lc]{Managing file objects}
+
+\begin{code}
+
+#include "rtsdefs.h"
+#include "stgio.h"
+#include "fileObject.h"
+
+void
+setBufFlags(fo, flg)
+StgForeignObj fo;
+StgInt flg;
+{
+ ((IOFileObject*)fo)->flags = flg;
+ return;
+}
+
+void
+setBufWPtr(fo, len)
+StgForeignObj fo;
+StgInt len;
+{
+ ((IOFileObject*)fo)->bufWPtr = len;
+ return;
+}
+
+StgInt
+getBufWPtr(fo)
+StgForeignObj fo;
+{
+ return (((IOFileObject*)fo)->bufWPtr);
+}
+
+StgInt
+getBufSize(fo)
+StgForeignObj fo;
+{
+ return (((IOFileObject*)fo)->bufSize);
+}
+
+void
+setBuf(fo, buf,sz)
+StgForeignObj fo;
+StgAddr buf;
+StgInt sz;
+{
+ ((IOFileObject*)fo)->buf = buf;
+ ((IOFileObject*)fo)->bufSize = sz;
+ return;
+}
+
+StgAddr
+getBuf(fo)
+StgForeignObj fo;
+{ return (((IOFileObject*)fo)->buf); }
+
+StgAddr
+getWriteableBuf(ptr)
+StgForeignObj ptr;
+{
+ /* getWriteableBuf() is called prior to starting to pack
+ a Haskell string into the IOFileObject buffer. It takes
+ care of flushing the (input) buffer in the case we're
+ dealing with a RW handle.
+ */
+ IOFileObject* fo = (IOFileObject*)ptr;
+
+ if ( FILEOBJ_READABLE(fo) && FILEOBJ_JUST_READ(fo) ) {
+ flushReadBuffer(ptr); /* ignoring return code */
+ /* Ahead of time really, but indicate that we're (just about to) write */
+ }
+ fo->flags = (fo->flags & ~FILEOBJ_RW_READ) | FILEOBJ_RW_WRITE;
+ return (fo->buf);
+}
+
+StgAddr
+getBufStart(fo,count)
+StgForeignObj fo;
+StgInt count;
+{ return ((char*)((IOFileObject*)fo)->buf + (((IOFileObject*)fo)->bufRPtr) - count); }
+
+StgInt
+getFileFd(fo)
+StgForeignObj fo;
+{ return (((IOFileObject*)fo)->fd); }
+
+StgInt
+getConnFileFd(fo)
+StgForeignObj fo;
+{ return (((IOFileObject*)fo)->connectedTo->fd); }
+
+
+void
+setFd(fo,fp)
+StgForeignObj fo;
+StgInt fp;
+{ ((IOFileObject*)fo)->fd = fp;
+ return;
+}
+
+void
+setConnectedTo(fo, fw, flg)
+StgForeignObj fo;
+StgForeignObj fw;
+StgInt flg;
+{
+ if( flg && (! isatty(((IOFileObject*)fo)->fd) || !isatty(((IOFileObject*)fw)->fd)) ) {
+ return;
+ }
+ ((IOFileObject*)fo)->connectedTo = (IOFileObject*)fw;
+ return;
+}
+
+static int __pushback_buf_size__ = 2;
+
+void
+setPushbackBufSize(i)
+StgInt i;
+{ __pushback_buf_size__ = (i > 0 ? i : 0); }
+
+StgInt
+getPushbackBufSize()
+{ return (__pushback_buf_size__); }
+
+void
+clearNonBlockingIOFlag__ (ptr)
+StgForeignObj ptr;
+{ ((IOFileObject*)ptr)->flags &= ~FILEOBJ_NONBLOCKING_IO; }
+
+void
+setNonBlockingIOFlag__ (ptr)
+StgForeignObj ptr;
+{ ((IOFileObject*)ptr)->flags |= FILEOBJ_NONBLOCKING_IO; }
+
+void
+clearConnNonBlockingIOFlag__ (ptr)
+StgForeignObj ptr;
+{ ((IOFileObject*)ptr)->connectedTo->flags &= ~FILEOBJ_NONBLOCKING_IO; }
+
+void
+setConnNonBlockingIOFlag__ (ptr)
+StgForeignObj ptr;
+{
+ if ( ((IOFileObject*)ptr)->connectedTo != NULL ) {
+ ((IOFileObject*)ptr)->connectedTo->flags |= FILEOBJ_NONBLOCKING_IO;
+ }
+ return;
+}
+
+
+/* Only ever called on line-buffered file objects */
+StgInt
+fill_up_line_buffer(fo)
+IOFileObject* fo;
+{
+ int count,len, ipos;
+ unsigned char* p;
+
+ /* ToDo: deal with buffer overflow (i.e., realloc buffer if this happens) */
+
+ if ( fo->bufRPtr == fo->bufWPtr ) { /* There's nothing in the buffer, reset */
+ fo->bufRPtr=0;
+ fo->bufWPtr=0;
+ }
+ ipos = fo->bufWPtr;
+ len = fo->bufSize - fo->bufWPtr + 1;
+ p = (unsigned char*)fo->buf + fo->bufWPtr;
+
+ if ( fo->flags & FILEOBJ_NONBLOCKING_IO && inputReady ((StgForeignObj)fo,0) != 1 )
+ return FILEOBJ_BLOCKED_READ;
+
+ if ((count = read(fo->fd, p, len)) <= 0) {
+ if (count == 0) {
+ ghc_errtype = ERR_EOF;
+ ghc_errstr = "";
+ FILEOBJ_SET_EOF(fo);
+ 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;
+ return (fo->bufWPtr - ipos);
+}
+
+
+
+\end{code}
#include "stgio.h"
StgInt
-getFilePosn(fp)
-StgForeignObj fp;
+getFilePosn(ptr)
+StgForeignObj ptr;
{
+ IOFileObject* fo = (IOFileObject*)ptr;
StgInt posn;
-
- while ((posn = ftell((FILE *) fp)) == -1) {
- /* the possibility seems awfully remote */
+
+ while ( (posn = lseek(fo->fd, 0, SEEK_CUR)) == -1) {
if (errno != EINTR) {
cvtErrno();
stdErrno();
return -1;
}
}
+ if (fo->flags & FILEOBJ_WRITE) {
+ posn += fo->bufWPtr;
+ } else if (fo->flags & FILEOBJ_READ) {
+ posn -= (fo->bufWPtr - fo->bufRPtr);
+ }
return posn;
}
-/* The following is only called with a position that we've already visited */
-
+/* The following is only called with a position that we've already visited
+ (this is ensured by making the Haskell file posn. type abstract.)
+*/
StgInt
-setFilePosn(fp, posn)
-StgForeignObj fp;
+setFilePosn(ptr, posn)
+StgForeignObj ptr;
StgInt posn;
{
- while (fseek((FILE *) fp, posn, SEEK_SET) != 0) {
+ IOFileObject* fo = (IOFileObject*)ptr;
+ int rc;
+
+ rc = flushBuffer(ptr);
+ if (rc < 0) return rc;
+
+ while (lseek(fo->fd, posn, SEEK_SET) == -1) {
if (errno != EINTR) {
cvtErrno();
stdErrno();
return -1;
}
}
+ FILEOBJ_CLEAR_EOF(fo);
return 0;
}
#include "stgio.h"
#include "error.h"
+#define TERMINATE_LINE(x) ((x) == '\n')
+
StgInt
-filePutc(fp, c)
-StgForeignObj fp;
+filePutc(ptr, c)
+StgForeignObj ptr;
StgInt c;
{
- int rc;
+ IOFileObject* fo = (IOFileObject*)ptr;
+ int rc = 0;
+
+ /* What filePutc needs to do:
+
+ - if there's no buffering => write it out.
+ - if the buffer is line-buffered
+ write out buffer (+char), iff buffer would be full afterwards ||
+ new char is the newline character
+ add to buffer , otherwise
+ - if the buffer is fully-buffered
+ write out buffer (+char), iff adding char fills up buffer.
+ add char to buffer, otherwise.
+
+ In the cases where a file is buffered, the invariant is that operations
+ that fill up a buffer also flushes them. A consequence of this here, is
+ that we're guaranteed to be passed a buffer with space for (at least)
+ the one char we're adding.
- /* Try to write a character */
- while ((rc = putc((int) c, (FILE *) fp)) == EOF && errno == EINTR)
- clearerr((FILE *) fp);
+ Supporting RW objects adds yet another twist, since we have to make
+ sure that if such objects have been read from just previously, we
+ flush(i.e., empty) the buffer first. (We could be smarter about this,
+ but aren't!)
+
+ */
+
+ if ( FILEOBJ_READABLE(fo) && FILEOBJ_JUST_READ(fo) ) {
+ rc = flushReadBuffer(ptr);
+ if (rc<0) return rc;
+ }
- if (rc == EOF) {
+ fo->flags = (fo->flags & ~FILEOBJ_RW_READ) | FILEOBJ_RW_WRITE;
+
+ /* check whether we can just add it to the buffer.. */
+ if ( FILEOBJ_UNBUFFERED(fo) ) {
+ ;
+ } else {
+ /* We're buffered, add it to the pack */
+ ((char*)fo->buf)[fo->bufWPtr] = (char)c;
+ fo->bufWPtr++;
+ /* If the buffer filled up as a result, *or*
+ the added character terminated a line
+ => flush.
+ */
+ if ( FILEOBJ_BUFFER_FULL(fo) ||
+ (FILEOBJ_LINEBUFFERED(fo) && TERMINATE_LINE(c)) ) {
+ rc = writeBuffer(ptr, fo->bufWPtr);
+ /* Undo the write if we're blocking..*/
+ if (rc == FILEOBJ_BLOCKED_WRITE ) fo->bufWPtr--;
+ }
+ return rc;
+ }
+
+ if ( fo->flags & FILEOBJ_NONBLOCKING_IO && inputReady(ptr,0) != 1 )
+ return FILEOBJ_BLOCKED_WRITE;
+
+ /* Unbuffered, write the character directly. */
+ while ((rc = write(fo->fd, &c, 1)) == 0 && errno == EINTR) ;
+
+ if (rc == 0) {
cvtErrno();
stdErrno();
return -1;
}
-
return 0;
+
}
\end{code}
#endif
StgInt
-fileSize(fp, result)
-StgForeignObj fp;
+fileSize(ptr, result)
+StgForeignObj ptr;
StgByteArray result;
{
+ IOFileObject* fo = (IOFileObject*)ptr;
struct stat sb;
+ int rc = 0;
- while (fstat(fileno((FILE *) fp), &sb) < 0) {
+ /* Flush buffer in order to get as an accurate size as poss. */
+ rc = flushFile(ptr);
+ if (rc < 0) return rc;
+
+ while (fstat(fo->fd, &sb) < 0) {
/* highly unlikely */
if (errno != EINTR) {
cvtErrno();
%
\subsection[flushFile.lc]{hFlush Runtime Support}
+Empty contents of output buffers.
+
\begin{code}
#include "rtsdefs.h"
#include "stgio.h"
StgInt
-flushFile(fp)
-StgForeignObj fp;
+flushFile(ptr)
+StgForeignObj ptr;
{
- int rc;
-
- while ((rc = fflush((FILE *) fp)) != 0) {
- if (errno != EINTR) {
- cvtErrno();
- stdErrno();
- return rc;
- }
+ IOFileObject* fo = (IOFileObject*)ptr;
+ int rc = 0;
+
+ if ( (fo->flags & FILEOBJ_FLUSH) && !FILEOBJ_BUFFER_EMPTY(fo) ) {
+ rc = writeBuffer(ptr,fo->bufWPtr - fo->bufRPtr);
+ }
+
+ return rc;
+}
+
+StgInt
+flushBuffer(ptr)
+StgForeignObj ptr;
+{
+ IOFileObject* fo = (IOFileObject*)ptr;
+ int rc = 0;
+
+ /* If the file object is writeable, or if its
+ RW and the last operation on it was a write,
+ flush it.
+ */
+ if ( (!FILEOBJ_READABLE(fo) && FILEOBJ_WRITEABLE(fo)) || (FILEOBJ_RW(fo) && FILEOBJ_JUST_WRITTEN(fo)) ) {
+ rc = flushFile(ptr);
+ if (rc<0) return rc;
+ }
+
+ /* Reset read & write pointer for input buffers */
+ if ( (fo->flags & FILEOBJ_READ) ) {
+ fo->bufRPtr=0;
+ fo->bufWPtr=0;
}
return 0;
}
+/*
+ For RW file objects, flushing input buffers doesn't just involve
+ resetting the read & write pointers, we also have to change the
+ underlying file position to point to the effective read position.
+
+ (Sigh, I now understand the real reason for why stdio opted for
+ the solution of leaving this to the programmer!)
+*/
+StgInt
+flushReadBuffer(ptr)
+StgForeignObj ptr;
+{
+ IOFileObject* fo = (IOFileObject*)ptr;
+ int delta;
+
+ delta = fo->bufWPtr - fo->bufRPtr;
+
+ if ( delta > 0 ) {
+ while ( lseek(fo->fd, -delta, SEEK_CUR) == -1) {
+ if (errno != EINTR) {
+ cvtErrno();
+ stdErrno();
+ return -1;
+ }
+ }
+ }
+
+ fo->bufRPtr=0;
+ fo->bufWPtr=0;
+ return 0;
+}
+
+
\end{code}
#include "rtsdefs.h"
#include "stgio.h"
+#include "fileObject.h"
/* sigh, the FILEs attached to the standard descriptors are
handled differently. We don't want them freed via the
StgForeignObj fp;
{ return; }
-void freeFile(fp)
-StgForeignObj fp;
-{
- int rc;
+void freeStdFileObject(ptr)
+StgForeignObj ptr;
+{
+ IOFileObject* fo = (IOFileObject*)ptr;
- if ( fp == NULL || (rc = unlockFile(fileno((FILE *)fp))) ) {
- /* If the file handle has been explicitly closed
- * (via closeFile()) or freed, we will have given
- * up our process lock, so we silently return here.
- */
- return;
+ /* Don't close the file, just flush the buffer */
+ if (fo != NULL && fo->fd != -1) {
+ if (fo->buf != NULL && (fo->flags & FILEOBJ_FLUSH) && fo->bufWPtr > 0) {
+ /* Flush buffer contents */
+ writeBuffer((StgForeignObj)fo, fo->bufWPtr);
}
+ }
+}
+void freeFileObject(ptr)
+StgForeignObj ptr;
+{
/*
- * The finaliser for the FILEs embedded in Handles. The RTS
+ * The finaliser for the file objects embedded in Handles. The RTS
* assumes that the finaliser runs without problems, so all
- * we can do here is fclose(), and hope nothing went wrong.
+ * we can do here is flish buffers + close(), and hope nothing went wrong.
*
- * Assume fclose() flushes output stream.
*/
- rc = fclose((FILE *)fp);
- /* Error or no error, we don't care.. */
+ int rc;
+ IOFileObject* fo = (IOFileObject*)ptr;
+
+ if ( fo == NULL )
+ return;
- /*
- if ( rc == EOF ) {
- fprintf(stderr. "Warning: file close ran into trouble\n");
+ if ( fo->fd == -1 || (rc = unlockFile(fo->fd)) ) {
+ /* If the file handle has been explicitly closed
+ * (via closeFile()), we will have given
+ * up our process lock, so we break off and just return.
+ */
+ return;
}
- */
+
+ if (fo->buf != NULL && fo->bufWPtr > 0) {
+ /* Flush buffer contents before closing underlying file */
+ fo->flags &= ~FILEOBJ_RW_WRITE | ~FILEOBJ_RW_READ;
+ flushFile(ptr);
+ }
+
+ rc = close(fo->fd);
+ /* Error or no error, we don't care.. */
return;
}
#define GBM_ERR (-3)
StgInt
-getBufferMode(fp)
-StgForeignObj fp;
+getBufferMode(ptr)
+StgForeignObj ptr;
{
+ IOFileObject* fo = (IOFileObject*)ptr;
struct stat sb;
+ int fd = fo->fd;
/* Try to find out the file type */
- while (fstat(fileno((FILE *) fp), &sb) < 0) {
+ while (fstat(fd, &sb) < 0) {
/* highly unlikely */
if (errno != EINTR) {
cvtErrno();
}
}
/* Terminals are line-buffered by default */
- if (S_ISCHR(sb.st_mode) && isatty(fileno((FILE *) fp)) == 1)
+ if (S_ISCHR(sb.st_mode) && isatty(fd) == 1) {
+ fo ->flags |= FILEOBJ_LB;
return GBM_LB;
/* Default size block buffering for the others */
- else
+ } else {
+ fo ->flags |= FILEOBJ_BB;
return GBM_BB;
+ }
}
\end{code}
}
StgInt
-getLock(fp, exclusive)
-StgForeignObj fp;
+getLock(fd, exclusive)
+StgInt fd;
StgInt exclusive;
{
- if (lockFile(fileno((FILE *) fp), exclusive) < 0) {
+ if (lockFile(fd, exclusive) < 0) {
if (errno == EBADF)
return 0;
else {
ghc_errstr = "file is locked";
break;
}
- (void) fclose((FILE *) fp);
+ /* Not so sure we want to do this, since getLock()
+ is only called on the standard file descriptors.. */
+ /*(void) close(fd); */
return -1;
}
}
#include <sys/time.h>
#endif
+/*
+ * inputReady(ptr, msecs) checks to see whether input is available
+ * on the file object 'ptr', timing out after (approx.) 'msec' milliseconds.
+ * Input meaning 'can I safely read at least a *character* from this file
+ * object without blocking?'
+ *
+ * If the file object has a non-empty buffer, the test is trivial. If not,
+ * we select() on the (readable) file descriptor.
+ *
+ * Notice that for file descriptors connected to ttys in non-canonical mode
+ * (i.e., it's buffered), inputReady will not return true until a *complete
+ * line* can be read.
+ */
+
StgInt
-inputReady(fp, msecs)
-StgForeignObj fp;
+inputReady(ptr, msecs)
+StgForeignObj ptr;
StgInt msecs;
{
- int flags, c, fd, maxfd, ready;
+ IOFileObject* fo = (IOFileObject*)ptr;
+ int c, fd, maxfd, ready;
fd_set rfd;
struct timeval tv;
- if (feof((FILE *) fp))
+ if ( FILEOBJ_IS_EOF(fo) )
return 0;
- fd = fileno((FILE *)fp);
-
- /* Get the original file status flags */
- while ((flags = fcntl(fd, F_GETFL)) < 0) {
- /* highly unlikely */
- if (errno != EINTR) {
- cvtErrno();
- stdErrno();
- return -1;
- }
+ if ( !FILEOBJ_BUFFER_EMPTY(fo) ) {
+ /* Don't look any further, there's stuff in the buffer */
+ return 1;
}
- /* If it's not already non-blocking, make it so */
- if (!(flags & O_NONBLOCK)) {
- while (fcntl(fd, F_SETFL, flags | O_NONBLOCK) < 0) {
- /* still highly unlikely */
- if (errno != EINTR) {
- cvtErrno();
- stdErrno();
- return -1;
- }
- }
- }
+ fd = fo->fd;
+
/* Now try to get a character */
FD_ZERO(&rfd);
FD_SET(fd, &rfd);
break;
}
}
- /*
- while ((c = getc((FILE *) fp)) == EOF && errno == EINTR)
- clearerr((FILE *) fp);
- */
-
- /* If we made it non-blocking for this, switch it back */
- if (!(flags & O_NONBLOCK)) {
- while (fcntl(fd, F_SETFL, flags) < 0) {
- /* still highly unlikely */
- if (errno != EINTR) {
- cvtErrno();
- stdErrno();
- return -1;
- }
- }
- }
+
/* 1 => Input ready, 0 => time expired (-1 error) */
return (ready);
- /*
- if (c == EOF) {
- if (errno == EAGAIN || feof((FILE *) fp)) {
- clearerr((FILE *) fp);
- return 0;
- } else {
- cvtErrno();
- stdErrno();
- return -1;
- }
- } else if (ungetc(c, (FILE *) fp) == EOF) {
- cvtErrno();
- stdErrno();
- return -1;
- } else
- return 1;
- */
}
\end{code}
#include "rtsdefs.h"
#include "stgio.h"
+#include "fileObject.h"
#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
#include <fcntl.h>
#endif
-StgAddr
-openFile(file, how)
+IOFileObject*
+openStdFile(fd,flags,rd)
+StgInt fd;
+StgInt flags;
+StgInt rd;
+{
+ IOFileObject* fo;
+
+ if ((fo = malloc(sizeof(IOFileObject))) == NULL)
+ return NULL;
+ fo->fd = fd;
+ fo->buf = NULL;
+ fo->bufWPtr = 0;
+ fo->bufRPtr = 0;
+ fo->flags = flags | FILEOBJ_STD | ( rd ? FILEOBJ_READ : FILEOBJ_WRITE);
+ fo->connectedTo = NULL;
+ return fo;
+}
+
+#define OPENFILE_APPEND 0
+#define OPENFILE_WRITE 1
+#define OPENFILE_READ_ONLY 2
+#define OPENFILE_READ_WRITE 3
+
+IOFileObject*
+openFile(file, how, binary, flags)
StgByteArray file;
-StgByteArray how;
+StgInt how;
+StgInt binary;
+StgInt flags;
{
FILE *fp;
int fd;
int exclusive;
int created = 0;
struct stat sb;
+ IOFileObject* fo;
/*
* Since we aren't supposed to succeed when we're opening for writing and
- * there's another writer, we can't just do an fopen() for "w" mode.
+ * there's another writer, we can't just do an open() with O_WRONLY.
*/
- switch (how[0]) {
- case 'a':
- oflags = O_WRONLY | O_NOCTTY | O_APPEND;
+ switch (how) {
+ case OPENFILE_APPEND:
+ oflags = O_WRONLY | O_NOCTTY | O_APPEND;
exclusive = 1;
break;
- case 'w':
+ case OPENFILE_WRITE:
oflags = O_WRONLY | O_NOCTTY;
exclusive = 1;
break;
- case 'r':
-#if defined(cygwin32_TARGET_OS)
- /* With cygwin32-b19, fdopen() returns EBADF under some
- hard-to-reproduce situations (causing hsc's renamer
- to break on some ~10 modules when recompiling it.)
- As a temporary workaround, we open files that was requested
- opened as read-only instead as read-write, since fdopen()
- only appears to fail on RO file descriptors.
-
- This won't have any impact on the correctness of the Haskell IO
- implementation since the Handle in Haskell land will record the
- file as being read-only, so illegal writes will be caught.
-
- ToDo: isolate and report.
- */
- oflags = how[1] == '+' ? O_RDWR | O_NOCTTY : O_RDWR | O_NOCTTY;
-#else
- oflags = how[1] == '+' ? O_RDWR | O_NOCTTY : O_RDONLY | O_NOCTTY;
-#endif
+ case OPENFILE_READ_ONLY:
+ oflags = O_RDONLY | O_NOCTTY;
+ exclusive = 0;
+ break;
+ case OPENFILE_READ_WRITE:
+ oflags = O_RDWR | O_NOCTTY;
exclusive = 0;
break;
default:
- fprintf(stderr, "openFile: unknown mode `%s'\n", how);
+ fprintf(stderr, "openFile: unknown mode `%d'\n", how);
EXIT(EXIT_FAILURE);
}
+#if HAVE_O_BINARY
+ if (binary)
+ oflags |= O_BINARY;
+#endif
+
/* First try to open without creating */
while ((fd = open(file, oflags, 0666)) < 0) {
if (errno == ENOENT) {
- if (how[0] == 'r' && how[1] == '\0') {
+ if ( how == OPENFILE_READ_ONLY ) {
/* For ReadMode, just bail out now */
ghc_errtype = ERR_NOSUCHTHING;
ghc_errstr = "file does not exist";
* ftruncate() is non-POSIX, so we truncate with a second open, which may fail.
*/
- if (how[0] == 'w') {
- int fd2;
+ if ( how == OPENFILE_WRITE ) {
+ int fd2, oflags2;
- oflags |= O_TRUNC;
- while ((fd2 = open(file, oflags, 0666)) < 0) {
+ oflags2 = oflags | O_TRUNC;
+ while ((fd2 = open(file, oflags2, 0666)) < 0) {
if (errno != EINTR) {
cvtErrno();
if (created)
}
close(fd2);
}
- errno = 0; /* Just in case fdopen() is lame */
- while ((fp = fdopen(fd, how)) == NULL) {
- if (errno != EINTR) {
-#if defined(cygwin32_TARGET_OS) && defined(DEBUG)
- fprintf(stderr, "openFile %s : %s : %d : %d\n", file, how, errno, fd);
-#endif
- cvtErrno();
- if (created)
- (void) unlink(file);
- (void) close(fd);
- return NULL;
- }
- }
- return (StgAddr) fp;
+ /* Allocate a IOFileObject to hold the information
+ we need to record per-handle for the various C stubs.
+ This chunk of memory is wrapped up inside a foreign object,
+ so it will be finalised and freed properly when we're
+ through with the handle.
+ */
+ if ((fo = malloc(sizeof(IOFileObject))) == NULL)
+ return NULL;
+
+ fo->fd = fd;
+ fo->buf = NULL;
+ fo->bufWPtr = 0;
+ fo->bufRPtr = 0;
+ fo->flags = flags | ( (how == OPENFILE_READ_ONLY || how == OPENFILE_READ_WRITE) ? FILEOBJ_READ : 0)
+ | ( (how == OPENFILE_APPEND || how == OPENFILE_READ_WRITE) ? FILEOBJ_WRITE : 0);
+ fo->connectedTo = NULL;
+ return fo;
}
-/*
- fdopen() plus implement locking.
-*/
-StgAddr
-openFd(fd,how)
+/* `Lock' file descriptor and return file object. */
+IOFileObject*
+openFd(fd,oflags,flags)
StgInt fd;
-StgByteArray how;
+StgInt oflags;
+StgInt flags;
{
int exclusive;
- int oflags;
FILE* fp;
-
- /*
- * Since we aren't supposed to succeed when we're opening for writing and
- * there's another writer, we can't just do an fopen() for "w" mode.
- */
-
- switch (how[0]) {
- case 'a':
- oflags = O_WRONLY | O_NOCTTY | O_APPEND;
- exclusive = 1;
- break;
- case 'w':
- oflags = O_WRONLY | O_NOCTTY;
- exclusive = 1;
- break;
- case 'r':
-#if defined(cygwin32_TARGET_OS)
- /* With cygwin32-b19, fdopen() returns EBADF under some
- hard-to-reproduce situations (causing hsc's renamer
- to break on some ~10 modules when recompiling it.)
- As a temporary workaround, we open files that was requested
- opened as read-only instead as read-write, since fdopen()
- only appears to fail on RO file descriptors.
-
- This won't have any impact on the correctness of the Haskell IO
- implementation since the Handle in Haskell land will record the
- file as being read-only, so illegal writes will be caught.
-
- ToDo: isolate and report.
- */
- oflags = how[1] == '+' ? O_RDWR | O_NOCTTY : O_RDWR | O_NOCTTY;
-#else
- oflags = how[1] == '+' ? O_RDWR | O_NOCTTY : O_RDONLY | O_NOCTTY;
-#endif
- exclusive = 0;
- break;
- default:
- fprintf(stderr, "openFd: unknown mode `%s'\n", how);
- EXIT(EXIT_FAILURE);
- }
-
+ IOFileObject* fo;
if (lockFile(fd, exclusive) < 0) {
cvtErrno();
ghc_errstr = "file is locked";
break;
}
- (void) close(fd);
return NULL;
}
- errno = 0; /* Just in case fdopen() is lame */
- while ((fp = fdopen(fd, how)) == NULL) {
- if (errno != EINTR) {
-#if defined(cygwin32_TARGET_OS) && defined(DEBUG)
- fprintf(stderr, "openFd %s : %s : %d : %d\n", file, how, errno, fd);
-#endif
- cvtErrno();
- (void) close(fd);
- return NULL;
- }
- }
- return (StgAddr) fp;
+ /* See openFileObject() comment */
+ if ((fo = malloc(sizeof(IOFileObject))) == NULL)
+ return NULL;
+ fo->fd = fd;
+ fo->buf = NULL;
+ fo->bufWPtr = 0;
+ fo->bufRPtr = 0;
+ fo->flags = flags | ( oflags & O_RDONLY ? FILEOBJ_READ
+ : oflags & O_RDWR ? FILEOBJ_READ
+ : 0)
+ | ( oflags & O_WRONLY ? FILEOBJ_WRITE
+ : oflags & O_RDWR ? FILEOBJ_WRITE
+ : 0);
+ fo->connectedTo = NULL;
+ return fo;
}
\end{code}
#define EOT 4
+/* Filling up a (block-buffered) buffer, that
+ is completely empty. */
StgInt
-readBlock(buf, fp, size)
-StgAddr buf;
-StgForeignObj fp;
-StgInt size;
+readBlock(ptr)
+StgForeignObj ptr;
{
- int count;
+ 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;
- if (feof((FILE *) fp)) {
+ fd = fo->fd;
+
+ if ( FILEOBJ_IS_EOF(fo) ) {
ghc_errtype = ERR_EOF;
ghc_errstr = "";
return -1;
}
- while ((count = fread(buf, 1, size, (FILE *) fp)) == 0) {
- if (feof((FILE *) fp)) {
+ /* 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((StgForeignObj)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 (errno != EINTR) {
+ } else if ( count == -1 && errno == EAGAIN) {
+ errno = 0;
+ return FILEOBJ_BLOCKED_READ;
+ } else if ( count == -1 && errno != EINTR) {
cvtErrno();
stdErrno();
return -1;
}
- clearerr((FILE *) fp);
}
-
+ fo->bufWPtr = count;
+ fo->bufRPtr = 0;
return count;
}
+/* Filling up a (block-buffered) buffer of length len */
StgInt
-readLine(buf, fp, size)
+readChunk(ptr,buf,len)
+StgForeignObj ptr;
StgAddr buf;
-StgForeignObj fp;
-StgInt size;
+StgInt len;
{
- if (feof((FILE *) fp)) {
+ IOFileObject* fo = (IOFileObject*)ptr;
+ int count=0,rc=0,orig_len;
+ 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;
}
- while (fgets(buf, size, (FILE *) fp) == NULL) {
- if (feof((FILE *) fp)) {
+ /* 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((StgForeignObj)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;
+
+ orig_len = len;
+ len -= count;
+ p = buf;
+ p += 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 ) {
+ FILEOBJ_SET_EOF(fo);
ghc_errtype = ERR_EOF;
ghc_errstr = "";
return -1;
- } else if (errno != EINTR) {
+ } else if ( count == -1 && errno == EAGAIN) {
+ errno = 0;
+ return FILEOBJ_BLOCKED_READ;
+ } else if ( count == -1 && errno != EINTR) {
cvtErrno();
stdErrno();
return -1;
}
- clearerr((FILE *) fp);
+ len -= count;
+ p += count;
+ }
+
+ fo->bufWPtr = orig_len;
+ fo->bufRPtr = 0;
+ return 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)
+StgForeignObj 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((StgForeignObj)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;
+ }
}
- return strlen(buf);
}
StgInt
-readChar(fp)
-StgForeignObj fp;
+readChar(ptr)
+StgForeignObj ptr;
{
- int c;
+ IOFileObject* fo= (IOFileObject*)ptr;
+ int count,rc=0;
+ char c;
- if (feof((FILE *) fp)) {
+ /* 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;
}
- while ((c = getc((FILE *) fp)) == EOF) {
- if (feof((FILE *) fp)) {
+ /* 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((StgForeignObj)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 (errno != EINTR) {
+ } else if ( count == -1 && errno == EAGAIN) {
+ errno = 0;
+ return FILEOBJ_BLOCKED_READ;
+ } else if ( count == -1 && errno != EINTR) {
cvtErrno();
stdErrno();
return -1;
}
- clearerr((FILE *) fp);
}
- if (isatty(fileno((FILE *) fp)) && c == EOT)
+ if ( isatty(fo->fd) && c == EOT ) {
return EOF;
- else
- return c;
+ } else {
+ return (int)c;
+ }
}
\end{code}
#include <sys/stat.h>
#endif
+/* Invoked by IO.hSeek only */
StgInt
-seekFile(fp, whence, size, d)
-StgForeignObj fp;
+seekFile(ptr, whence, size, d)
+StgForeignObj ptr;
StgInt whence;
StgInt size;
StgByteArray d;
{
+ IOFileObject* fo = (IOFileObject*)ptr;
struct stat sb;
- long int offset;
+ off_t offset;
+ int posn_delta =0;
+ int rc = 0;
+
+ switch (whence) {
+ case 0: whence=SEEK_SET; break;
+ case 1: whence=SEEK_CUR; break;
+ case 2: whence=SEEK_END; break;
+ default: whence=SEEK_SET; break; /* Should never happen, really */
+ }
/*
* We need to snatch the offset out of an MP_INT. The bits are there sans sign,
return -1;
}
+ /* If we're doing a relative seek, see if we cannot deal
+ * with the request without flushing the buffer..
+ *
+ * Note: the wording in the report is vague here, but
+ * we only avoid flushing on *input* buffers and *not* output ones.
+ */
+ if ( whence == SEEK_CUR &&
+ (FILEOBJ_READABLE(fo) && !FILEOBJ_WRITEABLE(fo) &&
+ (fo->bufRPtr + (int)offset) < fo->bufWPtr &&
+ (fo->bufRPtr + (int)offset) >= 0) ) { /* The input buffer case */
+ fo->bufRPtr += (int)offset;
+ return 0;
+ } else if ( whence == SEEK_CUR && (FILEOBJ_READABLE(fo) && !FILEOBJ_WRITEABLE(fo)) ) {
+ /* We're seeking outside the input buffer,
+ record delta so that we can adjust the file position
+ reported from the underlying fd to get
+ at the real position we're at when we take into account
+ buffering.
+ */
+ posn_delta = fo->bufWPtr - fo->bufRPtr; /* number of chars left in the buffer */
+ if (posn_delta < 0) posn_delta=0;
+ }
+
+ /* If we cannot seek within our current buffer, flush it. */
+ rc = flushBuffer(ptr);
+ if (rc < 0) return rc;
+
/* Try to find out the file type & size for a physical file */
- while (fstat(fileno((FILE *) fp), &sb) < 0) {
+ while (fstat(fo->fd, &sb) < 0) {
/* highly unlikely */
if (errno != EINTR) {
cvtErrno();
}
if (S_ISREG(sb.st_mode)) {
/* Verify that we are not seeking beyond end-of-file */
- int posn;
+ off_t posn;
switch (whence) {
case SEEK_SET:
posn = offset;
break;
case SEEK_CUR:
- while ((posn = ftell((FILE *) fp)) == -1) {
+ while ((posn = lseek(fo->fd, 0, SEEK_CUR)) == -1) {
/* the possibility seems awfully remote */
if (errno != EINTR) {
cvtErrno();
return -1;
}
}
+ posn -= posn_delta;
posn += offset;
+ offset -= posn_delta; /* adjust the offset to include the buffer delta */
break;
case SEEK_END:
- posn = sb.st_size + offset;
+ posn = (off_t)sb.st_size + offset;
break;
}
if (posn > sb.st_size) {
ghc_errstr = "can't seek on a device";
return -1;
}
- while (fseek((FILE *) fp, offset, whence) != 0) {
+ while ( lseek(fo->fd, offset, whence) == -1) {
if (errno != EINTR) {
cvtErrno();
stdErrno();
return -1;
}
}
+ /* Clear EOF */
+ FILEOBJ_CLEAR_EOF(fo);
return 0;
}
StgInt
-seekFileP(fp)
-StgForeignObj fp;
+seekFileP(ptr)
+StgForeignObj ptr;
{
+ IOFileObject* fo = (IOFileObject*)ptr;
struct stat sb;
/* Try to find out the file type */
- while (fstat(fileno((FILE *) fp), &sb) < 0) {
+ while (fstat(fo->fd, &sb) < 0) {
/* highly unlikely */
if (errno != EINTR) {
cvtErrno();
}
\end{code}
-
-
-
#define SB_BB (-2)
StgInt
-setBuffering(fp, size)
-StgForeignObj fp;
+setBuffering(ptr, size)
+StgForeignObj ptr;
StgInt size;
{
- int flags;
- int input;
+ IOFileObject* fo = (IOFileObject*)ptr;
+ int flags, rc=0;
+ int input, isaterm;
struct termios tio;
+ struct stat sb;
+
- while ((flags = fcntl(fileno((FILE *) fp), F_GETFL)) < 0) {
+ /* First off, flush old buffer.. */
+ if ( (fo->flags & FILEOBJ_FLUSH) ) {
+ rc = flushBuffer(ptr);
+ }
+ if (rc<0) return rc;
+
+ /* Let go of old buffer, and reset buffer pointers. */
+ if ( fo->buf != NULL ) {
+ free(fo->buf);
+ fo->bufWPtr = 0;
+ fo->bufRPtr = 0;
+ fo->bufSize = 0;
+ fo->buf = NULL;
+ }
+
+ while ((flags = fcntl(fo->fd, F_GETFL)) < 0) {
if (errno != EINTR) {
cvtErrno();
stdErrno();
flags &= O_ACCMODE;
input = flags == O_RDONLY || flags == O_RDWR;
+ isaterm = input && isatty(fo->fd);
+
switch (size) {
case SB_NB:
- if (setvbuf((FILE *) fp, NULL, _IONBF, 0L) != 0) {
- cvtErrno();
- stdErrno();
- return -1;
- }
- if (input && isatty(fileno((FILE *) fp))) {
-
- /*
- * Try to switch to CBREAK mode, or whatever they call it these days.
- */
+ fo->flags &= ~FILEOBJ_LB & ~FILEOBJ_BB;
- if (tcgetattr(fileno((FILE *) fp), &tio) < 0) {
+ if (isaterm) {
+ /* Switch over to canonical mode. */
+ if (tcgetattr(fo->fd, &tio) < 0) {
cvtErrno();
stdErrno();
return -1;
}
- tio.c_lflag &= ~ICANON;
+ tio.c_lflag &= ~ICANON;
tio.c_cc[VMIN] = 1;
tio.c_cc[VTIME] = 0;
- if (tcsetattr(fileno((FILE *) fp), TCSANOW, &tio) < 0) {
+ if (tcsetattr(fo->fd, TCSANOW, &tio) < 0) {
cvtErrno();
stdErrno();
return -1;
}
}
return 0;
- break;
case SB_LB:
- if (setvbuf((FILE *) fp, NULL, _IOLBF, BUFSIZ) != 0) {
- cvtErrno();
- stdErrno();
- return -1;
- }
+ fo->flags &= ~FILEOBJ_BB;
+ fo->flags |= FILEOBJ_LB;
+ size = BUFSIZ;
break;
case SB_BB:
- /*
- * We should actually peek at the buffer size in the stat struct, if there
- * is one. Something to occupy us later, when we're bored.
- */
+#if HAVE_ST_BLKSIZE
+ while (fstat(fo->fd, &sb) < 0) {
+ /* not very likely.. */
+ if ( errno != EINTR ) {
+ cvtErrno();
+ stdErrno();
+ return -1;
+ }
+ }
+ size = sb->st_blksize;
+#else
size = BUFSIZ;
+#endif
+ fo->flags &= ~FILEOBJ_LB;
+ fo->flags |= FILEOBJ_BB;
/* fall through */
default:
- if (setvbuf((FILE *) fp, NULL, _IOFBF, size) != 0) {
- cvtErrno();
- stdErrno();
- return -1;
- }
break;
}
- if (input && isatty(fileno((FILE *) fp))) {
+
+ if ( size > 0) {
+ fo->buf = malloc(size*sizeof(char));
+ if (fo->buf == NULL) {
+ return -1;
+ }
+ fo->bufSize = size;
+ }
+ if (isaterm) {
/*
* Try to switch back to cooked mode.
*/
- if (tcgetattr(fileno((FILE *) fp), &tio) < 0) {
+ if (tcgetattr(fo->fd, &tio) < 0) {
cvtErrno();
stdErrno();
return -1;
}
tio.c_lflag |= ICANON;
- if (tcsetattr(fileno((FILE *) fp), TCSANOW, &tio) < 0) {
+ if (tcsetattr(fo->fd, TCSANOW, &tio) < 0) {
cvtErrno();
stdErrno();
return -1;
#ifndef STGIO_H
#define STGIO_H
+#include "fileObject.h"
+
/* Decls for routines in ghc/lib/cbits/ only used there.
* This file is used when compiling the Haskell library
* that _ccalls_ those routines; and when compiling those
*/
/* closeFile.lc */
-StgInt closeFile PROTO((StgForeignObj));
+StgAddr allocMemory__ PROTO((StgInt));
+
+/* closeFile.lc */
+StgInt closeFile PROTO((StgForeignObj,StgInt));
/* createDirectory.lc */
StgInt createDirectory PROTO((StgByteArray));
extern int ghc_errtype;
void cvtErrno(STG_NO_ARGS);
void stdErrno(STG_NO_ARGS);
+StgAddr getErrStr__(STG_NO_ARGS);
+StgInt getErrNo__(STG_NO_ARGS);
+StgInt getErrType__(STG_NO_ARGS);
/* execvpe.lc */
int execvpe PROTO((char *, char **, char **));
/* fileLookAhead.lc */
StgInt fileLookAhead PROTO((StgForeignObj));
+StgInt ungetChar PROTO((StgForeignObj,StgInt));
+
+/* fileObject.lc */
+void setBufFlags PROTO((StgForeignObj, StgInt));
+void setBufWPtr PROTO((StgForeignObj, StgInt));
+StgInt getBufWPtr PROTO((StgForeignObj));
+void setBuf PROTO((StgForeignObj, StgAddr, StgInt));
+StgAddr getBuf PROTO((StgForeignObj));
+StgAddr getWriteableBuf PROTO((StgForeignObj));
+StgAddr getBufStart PROTO((StgForeignObj,StgInt));
+StgInt getBufSize PROTO((StgForeignObj));
+void setFilePtr PROTO((StgForeignObj, StgAddr));
+StgAddr getFilePtr PROTO((StgForeignObj));
+void setConnectedTo PROTO((StgForeignObj, StgForeignObj, StgInt));
+void setPushbackBufSize PROTO((StgInt));
+StgInt getPushbackBufSize (STG_NO_ARGS);
+void setNonBlockingIOFlag__ PROTO((StgForeignObj));
+void clearNonBlockingIOFlag__ PROTO((StgForeignObj));
+void setConnNonBlockingIOFlag__ PROTO((StgForeignObj));
+void clearConnNonBlockingIOFlag__ PROTO((StgForeignObj));
+StgInt getFileFd PROTO((StgForeignObj));
+StgInt getConnFileFd PROTO((StgForeignObj));
/* filePosn.lc */
StgInt getFilePosn PROTO((StgForeignObj));
/* flushFile.lc */
StgInt flushFile PROTO((StgForeignObj));
+StgInt flushBuffer PROTO((StgForeignObj));
+StgInt flushReadBuffer PROTO((StgForeignObj));
/* freeFile.lc */
void freeStdFile PROTO((StgForeignObj));
void freeFile PROTO((StgForeignObj));
+void freeStdFileObject PROTO((StgForeignObj));
+void freeFileObject PROTO((StgForeignObj));
/* getBufferMode.lc */
StgInt getBufferMode PROTO((StgForeignObj));
/* getLock.lc */
int lockFile PROTO((int, int));
int unlockFile PROTO((int));
-StgInt getLock PROTO((StgForeignObj, StgInt));
+StgInt getLock PROTO((StgInt, StgInt));
/* inputReady.lc */
StgInt inputReady PROTO((StgForeignObj,StgInt));
/* openFile.lc */
-StgAddr openFile PROTO((StgByteArray, StgByteArray));
-StgAddr openFd PROTO((StgInt, StgByteArray));
+IOFileObject* openFile PROTO((StgByteArray, StgInt, StgInt, StgInt));
+IOFileObject* openFd PROTO((StgInt, StgInt, StgInt));
+IOFileObject* openStdFile PROTO((StgInt, StgInt, StgInt));
/* readFile.lc */
-StgInt readBlock PROTO((StgAddr, StgForeignObj, StgInt));
-StgInt readLine PROTO((StgAddr, StgForeignObj, StgInt));
+StgInt readBlock PROTO((StgForeignObj));
+StgInt readChunk PROTO((StgForeignObj,StgAddr,StgInt));
+StgInt readLine PROTO((StgForeignObj));
StgInt readChar PROTO((StgForeignObj));
/* removeDirectory.lc */
/* toClockSec.lc */
StgAddr toClockSec PROTO((StgInt, StgInt, StgInt, StgInt, StgInt, StgInt, StgInt, StgByteArray));
+/* writeError.lc */
+void writeErrString__ PROTO((StgAddr, StgByteArray, StgInt));
/* writeFile.lc */
StgInt writeFile PROTO((StgAddr, StgForeignObj, StgInt));
+StgInt writeBuf PROTO((StgForeignObj, StgAddr, StgInt));
+StgInt writeBufBA PROTO((StgForeignObj, StgByteArray, StgInt));
+StgInt writeFileObject PROTO((StgForeignObj, StgInt));
+StgInt writeBuffer PROTO((StgForeignObj, StgInt));
#endif /* ! STGIO_H */
--- /dev/null
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1998
+%
+
+Writing out error messages. This is done outside Haskell
+(i.e., no use of the IO implementation is made), since it
+might be in an unstable state (e.g., hClose stderr >> error "foo")
+
+(A secondary reason is that ``error'' is used by the IO
+implementation in one or two places.)
+
+\begin{code}
+
+#include "rtsdefs.h"
+#include "stgio.h"
+
+void
+writeErrString__ (msg_hdr, msg, len)
+StgAddr msg_hdr;
+StgByteArray msg;
+StgInt len;
+{
+ int count = 0;
+ char* p = (char*)msg;
+ char nl = '\n';
+
+ /* Print error msg header */
+ ((void (*)(int))msg_hdr)(2/*stderr*/);
+
+ while ( (count = write(2,p,len)) < len) {
+ if (errno != EINTR ) {
+ return;
+ }
+ len -= count;
+ p += count;
+ }
+ write(2, &nl, 1);
+}
+
+\end{code}
#include "stgio.h"
StgInt
-writeFile(buf, fp, bytes)
-StgAddr buf;
-StgForeignObj fp;
+writeFileObject(ptr, bytes)
+StgForeignObj ptr;
StgInt bytes;
{
- int count;
- char *p = (char *) buf;
+ int rc=0;
+ IOFileObject* fo = (IOFileObject*)ptr;
- if (bytes == 0)
- return 0;
+ char *p = (char *) fo->buf;
+
+ /* If we've got a r/w file object in our hand, flush the
+ (input) buffer contents first.
+ */
+ if ( FILEOBJ_READABLE(fo) && FILEOBJ_JUST_READ(fo) ) {
+ fo->flags = (fo->flags & ~FILEOBJ_RW_READ) | FILEOBJ_RW_WRITE;
+ rc = flushReadBuffer(ptr);
+ if (rc < 0) return rc;
+ }
+
+ return (writeBuffer(ptr, bytes));
+}
+
+StgInt
+writeBuffer(ptr, bytes)
+StgForeignObj ptr;
+StgInt bytes;
+{
+ int count, rc=0;
+ IOFileObject* fo = (IOFileObject*)ptr;
+
+ char *p = (char *) fo->buf;
/* Disallow short writes */
- while ((count = fwrite(p, 1, bytes, (FILE *) fp)) < bytes) {
+ if (bytes == 0 || fo->buf == NULL)
+ return 0;
+
+ if ( fo->flags & FILEOBJ_NONBLOCKING_IO && inputReady(ptr,0) != 1 )
+ return FILEOBJ_BLOCKED_WRITE;
+
+ while ((count = write(fo->fd, fo->buf, bytes)) < bytes) {
if (errno != EINTR) {
cvtErrno();
stdErrno();
}
bytes -= count;
p += count;
- clearerr((FILE *) fp);
}
-
+ /* Signal that we've emptied the buffer */
+ fo->bufWPtr=0;
return 0;
}
StgInt
-writeBuf(fp, elt_sz, len, buf)
-StgForeignObj fp;
-StgWord elt_sz;
-StgInt len;
+writeBuf(ptr, buf, len)
+StgForeignObj ptr;
StgAddr buf;
+StgInt len;
{
+ IOFileObject* fo = (IOFileObject*)ptr;
int count;
+ int rc = 0;
char *p = (char *) buf;
- if (len == 0 || elt_sz == 0)
+ if (len == 0 )
return 0;
+ /* First of all, check if we do need to flush the buffer .. */
+ /* Note - in the case of line buffering, we do not currently check
+ whether we need to flush buffer due to line terminators in the
+ buffer we're outputting */
+ if ( fo->buf != NULL && /* buffered and */
+ (fo->bufWPtr + len < (fo->bufSize)) /* there's room */
+ ) {
+ /* Block copying is likely to be cheaper than, flush, followed by write */
+ memcpy(((char*)fo->buf + fo->bufWPtr), buf, len);
+ fo->bufWPtr += len;
+ return 0;
+ }
+ /* If we do overflow, flush current contents of the buffer and
+ directly output the chunk.
+ (no attempt at splitting up the chunk is currently made)
+ */
+ if ( fo->buf != NULL && /* buffered and */
+ (fo->bufWPtr + len >= (fo->bufSize)) /* there's not room */
+ ) {
+ /* Flush buffer */
+ rc = writeFileObject(ptr, fo->bufWPtr);
+ /* ToDo: undo buffer fill if we're blocking.. */
+ }
+
+ if (rc != 0) {
+ return rc;
+ }
+
+ if ( fo->flags & FILEOBJ_NONBLOCKING_IO && inputReady(ptr,0) != 1 )
+ return FILEOBJ_BLOCKED_WRITE;
+
/* Disallow short writes */
- while ((count = fwrite((char *)buf, (unsigned)elt_sz, (int)len, (FILE *) fp)) < len) {
+ while ((count = write(fo->fd, (char *)buf, (int)len)) < len) {
if (errno != EINTR) {
cvtErrno();
stdErrno();
}
len -= count;
p += count;
- clearerr((FILE *) fp);
}
return 0;
}
+StgInt
+writeBufBA(ptr, buf, len)
+StgForeignObj ptr;
+StgByteArray buf;
+StgInt len;
+{ return (writeBuf(ptr,(StgAddr)buf, len)); }
+
+
\end{code}
projects / ghc-hetmet.git / commitdiff