[project @ 1998-04-07 08:23:07 by sof]

new function: writeBuf

2 files changed, 31 insertions, 2 deletions

diff --git a/ghc/lib/std/cbits/filePutc.lc b/ghc/lib/std/cbits/filePutc.lc
index 4e6b85bb04..980aa63e50 100644
--- a/ghc/lib/std/cbits/filePutc.lc
+++ b/ghc/lib/std/cbits/filePutc.lc
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1994
 %
-\subsection[filePuc.lc]{hPutChar Runtime Support}
+\subsection[filePut.lc]{hPutChar Runtime Support}
 
 \begin{code}
 
@@ -16,7 +16,7 @@ StgInt c;
 {
     int rc;
 
-    /* Try to read a character */
+    /* Try to write a character */
     while ((rc = putc((int) c, (FILE *) fp)) == EOF && errno == EINTR)
 	clearerr((FILE *) fp);
 
diff --git a/ghc/lib/std/cbits/writeFile.lc b/ghc/lib/std/cbits/writeFile.lc
index 71c7b0df17..80b946f117 100644
--- a/ghc/lib/std/cbits/writeFile.lc
+++ b/ghc/lib/std/cbits/writeFile.lc
@@ -35,4 +35,33 @@ StgInt bytes;
     return 0;
 }
 
+
+StgInt
+writeBuf(fp, elt_sz, len, buf)
+StgForeignObj fp;
+StgWord elt_sz;
+StgInt  len;
+StgAddr buf;
+{
+    int count;
+    char *p = (char *) buf;
+
+    if (len == 0 || elt_sz == 0)
+	return 0;
+
+    /* Disallow short writes */
+    while ((count = fwrite((char *)buf, (unsigned)elt_sz, (int)len, (FILE *) fp)) < len) {
+	if (errno != EINTR) {
+	    cvtErrno();
+	    stdErrno();
+	    return -1;
+	}
+	len -= count;
+	p += count;
+	clearerr((FILE *) fp);
+    }
+
+    return 0;
+}
+
 \end{code}