[project @ 2000-10-10 09:28:50 by simonmar]
[ghc-hetmet.git] / ghc / lib / std / cbits / fileObject.c
1 /* 
2  * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
3  *
4  * $Id: fileObject.c,v 1.11 2000/10/10 09:28:50 simonmar Exp $
5  *
6  * hPutStr Runtime Support
7  */
8
9 #include "Rts.h"
10 #include "stgio.h"
11
12 #include <stdio.h>
13
14 #if defined(HAVE_WINSOCK_H) && !defined(__CYGWIN__) && !defined(__CYGWIN32__)
15 #define USE_WINSOCK
16 #endif
17
18 #ifdef USE_WINSOCK
19 #include <winsock.h>
20 #endif
21
22 void
23 setBufFlags(StgForeignPtr fo, StgInt flg)
24 {
25   ((IOFileObject*)fo)->flags = flg;
26   return;
27 }
28
29 void
30 setBufWPtr(StgForeignPtr fo, StgInt len)
31 {
32   ((IOFileObject*)fo)->bufWPtr = len;
33   return;
34 }
35
36 StgInt
37 getBufWPtr(StgForeignPtr fo)
38 {
39   return (((IOFileObject*)fo)->bufWPtr);
40 }
41
42 StgInt
43 getBufSize(StgForeignPtr fo)
44 {
45   return (((IOFileObject*)fo)->bufSize);
46 }
47
48 void
49 setBuf(StgForeignPtr fo, StgAddr buf,StgInt sz)
50 {
51   ((IOFileObject*)fo)->buf     = buf;
52   ((IOFileObject*)fo)->bufSize = sz;
53   return;
54 }
55
56 StgAddr
57 getBuf(StgForeignPtr fo)
58 { return (((IOFileObject*)fo)->buf); }
59
60 StgAddr
61 getWriteableBuf(StgForeignPtr ptr)
62
63    /* getWriteableBuf() is called prior to starting to pack
64       a Haskell string into the IOFileObject buffer. It takes
65       care of flushing the (input) buffer in the case we're
66       dealing with a RW handle.
67    */
68    IOFileObject* fo = (IOFileObject*)ptr;
69
70    if ( FILEOBJ_READABLE(fo) && FILEOBJ_JUST_READ(fo) ) {
71       flushReadBuffer(ptr);  /* ignoring return code */
72       /* Ahead of time really, but indicate that we're (just about to) write */
73    }
74    fo->flags = (fo->flags & ~FILEOBJ_RW_READ) | FILEOBJ_RW_WRITE;
75    return (fo->buf);
76 }
77
78 StgAddr
79 getBufStart(StgForeignPtr fo, StgInt count)
80 { return ((char*)((IOFileObject*)fo)->buf + (((IOFileObject*)fo)->bufRPtr) - count); }
81
82 StgInt
83 getFileFd(StgForeignPtr fo)
84 { return (((IOFileObject*)fo)->fd); }
85
86 StgInt
87 getConnFileFd(StgForeignPtr fo)
88 { return (((IOFileObject*)fo)->connectedTo->fd); }
89
90
91 void
92 setFd(StgForeignPtr fo,StgInt fp)
93 { ((IOFileObject*)fo)->fd = fp;
94   return;
95 }
96
97 void
98 setConnectedTo(StgForeignPtr fo, StgForeignPtr fw, StgInt flg)
99 {
100   if( flg && (! isatty(((IOFileObject*)fo)->fd) || !isatty(((IOFileObject*)fw)->fd)) ) {
101       return;
102   }
103  ((IOFileObject*)fo)->connectedTo = (IOFileObject*)fw;
104   return;
105 }
106
107 static int __pushback_buf_size__ = 2;
108
109 void
110 setPushbackBufSize(StgInt i)
111 { __pushback_buf_size__ = (i > 0 ? i : 0); }
112
113 StgInt
114 getPushbackBufSize(void)
115 { return (__pushback_buf_size__); }
116
117 /* Only ever called on line-buffered file objects */
118 StgInt
119 fill_up_line_buffer(IOFileObject* fo)
120 {
121   int count,len, ipos;
122   unsigned char* p;
123
124   /* ToDo: deal with buffer overflow (i.e., realloc buffer if this happens) */
125  
126   if ( fo->bufRPtr == fo->bufWPtr ) { /* There's nothing in the buffer, reset */
127       fo->bufRPtr=0;
128       fo->bufWPtr=0;
129   }
130   ipos = fo->bufWPtr;
131   len = fo->bufSize - fo->bufWPtr;
132   p   = (unsigned char*)fo->buf + fo->bufWPtr;
133
134   while ((count = 
135          (
136 #ifdef USE_WINSOCK
137            fo->flags & FILEOBJ_WINSOCK ?
138            recv(fo->fd, p, len, 0) :
139            read(fo->fd, p, len))) <= 0 ) {
140 #else
141            read(fo->fd, p, len))) <= 0 ) {
142 #endif    
143       if (count == 0) {
144          ghc_errtype = ERR_EOF;
145          ghc_errstr = "";
146          FILEOBJ_SET_EOF(fo);
147          return -1;
148       } else if ( count == -1 && errno == EAGAIN) {
149          errno = 0;
150          return FILEOBJ_BLOCKED_READ;
151       } else if ( count == -1 && errno != EINTR ) {
152          cvtErrno();
153          stdErrno();
154          return -1;
155       }
156   }
157   fo->bufWPtr += count;
158 /* TODO: ipos doesn't change???? what's it for??? --SDM */
159   return (fo->bufWPtr - ipos);
160 }