summaryrefslogtreecommitdiff
path: root/ghc/lib/std/cbits/filePutc.c
diff options
context:
space:
mode:
authorsimonm <unknown>1998-12-02 13:32:30 +0000
committersimonm <unknown>1998-12-02 13:32:30 +0000
commit438596897ebbe25a07e1c82085cfbc5bdb00f09e (patch)
treeda7a441396aed2e13f6e0cc55282bf041b0cf72c /ghc/lib/std/cbits/filePutc.c
parent967cc47f37cb93a5e2b6df7822c9a646f0428247 (diff)
downloadhaskell-438596897ebbe25a07e1c82085cfbc5bdb00f09e.tar.gz
[project @ 1998-12-02 13:17:09 by simonm]
Move 4.01 onto the main trunk.
Diffstat (limited to 'ghc/lib/std/cbits/filePutc.c')
-rw-r--r--ghc/lib/std/cbits/filePutc.c86
1 files changed, 86 insertions, 0 deletions
diff --git a/ghc/lib/std/cbits/filePutc.c b/ghc/lib/std/cbits/filePutc.c
new file mode 100644
index 0000000000..6a86dc40f8
--- /dev/null
+++ b/ghc/lib/std/cbits/filePutc.c
@@ -0,0 +1,86 @@
+/*
+ * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
+ *
+ * $Id: filePutc.c,v 1.3 1998/12/02 13:27:29 simonm Exp $
+ *
+ * hPutChar Runtime Support
+ */
+
+#include "Rts.h"
+#include "stgio.h"
+#include "error.h"
+
+#define TERMINATE_LINE(x) ((x) == '\n')
+
+StgInt
+filePutc(ptr, c)
+StgForeignPtr ptr;
+StgChar c;
+{
+ 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.
+
+ 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;
+ }
+
+ 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;
+
+}