[project @ 1998-11-26 09:17:22 by sof]
[ghc-hetmet.git] / ghc / lib / std / cbits / writeFile.lc
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1994
3 %
4 \subsection[writeFile.lc]{hPutStr Runtime Support}
5
6 \begin{code}
7
8 #include "rtsdefs.h"
9 #include "stgio.h"
10
11 StgInt
12 writeFileObject(ptr, bytes)
13 StgForeignObj ptr;
14 StgInt bytes;
15 {
16     int rc=0;
17     IOFileObject* fo = (IOFileObject*)ptr;
18
19     char *p = (char *) fo->buf;
20
21     /* If we've got a r/w file object in our hand, flush the
22        (input) buffer contents first.
23     */
24     if ( FILEOBJ_READABLE(fo) && FILEOBJ_JUST_READ(fo) ) {
25        fo->flags = (fo->flags & ~FILEOBJ_RW_READ) | FILEOBJ_RW_WRITE;
26        rc = flushReadBuffer(ptr);
27        if (rc < 0) return rc;
28     }
29
30     return (writeBuffer(ptr, bytes));
31 }
32
33 StgInt
34 writeBuffer(ptr, bytes)
35 StgForeignObj ptr;
36 StgInt bytes;
37 {
38     int count, rc=0;
39     IOFileObject* fo = (IOFileObject*)ptr;
40
41     char *p = (char *) fo->buf;
42
43     /* Disallow short writes */
44     if (bytes == 0  || fo->buf == NULL)
45         return 0;
46
47     if ( fo->flags & FILEOBJ_NONBLOCKING_IO && inputReady(ptr,0) != 1 )
48        return FILEOBJ_BLOCKED_WRITE;
49
50     while ((count = write(fo->fd, fo->buf, bytes)) < bytes) {
51         if (errno != EINTR) {
52             cvtErrno();
53             stdErrno();
54             return -1;
55         }
56         bytes -= count;
57         p += count;
58     }
59     /* Signal that we've emptied the buffer */
60     fo->bufWPtr=0;
61     return 0;
62 }
63
64
65 StgInt
66 writeBuf(ptr, buf, len)
67 StgForeignObj ptr;
68 StgAddr buf;
69 StgInt  len;
70 {
71     IOFileObject* fo = (IOFileObject*)ptr;
72     int count;
73     int rc = 0;
74     char *p = (char *) buf;
75
76     if (len == 0 )
77         return 0;
78
79
80     /* First of all, check if we do need to flush the buffer .. */
81     /* Note - in the case of line buffering, we do not currently check
82        whether we need to flush buffer due to line terminators in the
83        buffer we're outputting */
84     if ( fo->buf != NULL                     &&   /* buffered and */
85          (fo->bufWPtr + len < (fo->bufSize))      /* there's room */
86        ) {
87        /* Block copying is likely to be cheaper than, flush, followed by write */
88        memcpy(((char*)fo->buf + fo->bufWPtr), buf, len);
89        fo->bufWPtr += len;
90        return 0;
91     }
92     /* If we do overflow, flush current contents of the buffer and
93        directly output the chunk.
94        (no attempt at splitting up the chunk is currently made)
95     */       
96     if ( fo->buf != NULL                     &&    /* buffered and */
97          (fo->bufWPtr + len >= (fo->bufSize))       /* there's not room */
98        ) {
99        /* Flush buffer */
100        rc = writeFileObject(ptr, fo->bufWPtr);
101        /* ToDo: undo buffer fill if we're blocking.. */
102     }
103
104     if (rc != 0) { 
105        return rc;
106     }
107
108     if ( fo->flags & FILEOBJ_NONBLOCKING_IO && inputReady(ptr,0) != 1 )
109        return FILEOBJ_BLOCKED_WRITE;
110
111     /* Disallow short writes */
112     while ((count = write(fo->fd, (char *)buf, (int)len)) < len) {
113         if (errno != EINTR) {
114             cvtErrno();
115             stdErrno();
116             return -1;
117         }
118         len -= count;
119         p += count;
120     }
121
122     return 0;
123 }
124
125 StgInt
126 writeBufBA(ptr, buf, len)
127 StgForeignObj ptr;
128 StgByteArray buf;
129 StgInt  len;
130 { return (writeBuf(ptr,(StgAddr)buf, len)); }
131
132
133 \end{code}