1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
/*
* (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
*
* $Id: fileObject.c,v 1.9 2000/04/12 17:33:16 simonmar Exp $
*
* hPutStr Runtime Support
*/
#include "Rts.h"
#include "stgio.h"
#include <stdio.h>
#if defined(HAVE_WINSOCK_H) && !defined(__CYGWIN__) && !defined(__CYGWIN32__)
#define USE_WINSOCK
#endif
#ifdef USE_WINSOCK
#include <winsock.h>
#endif
void
setBufFlags(StgForeignPtr fo, StgInt flg)
{
((IOFileObject*)fo)->flags = flg;
return;
}
void
setBufWPtr(StgForeignPtr fo, StgInt len)
{
((IOFileObject*)fo)->bufWPtr = len;
return;
}
StgInt
getBufWPtr(StgForeignPtr fo)
{
return (((IOFileObject*)fo)->bufWPtr);
}
StgInt
getBufSize(StgForeignPtr fo)
{
return (((IOFileObject*)fo)->bufSize);
}
void
setBuf(StgForeignPtr fo, StgAddr buf,StgInt sz)
{
((IOFileObject*)fo)->buf = buf;
((IOFileObject*)fo)->bufSize = sz;
return;
}
StgAddr
getBuf(StgForeignPtr fo)
{ return (((IOFileObject*)fo)->buf); }
StgAddr
getWriteableBuf(StgForeignPtr 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(StgForeignPtr fo, StgInt count)
{ return ((char*)((IOFileObject*)fo)->buf + (((IOFileObject*)fo)->bufRPtr) - count); }
StgInt
getFileFd(StgForeignPtr fo)
{ return (((IOFileObject*)fo)->fd); }
StgInt
getConnFileFd(StgForeignPtr fo)
{ return (((IOFileObject*)fo)->connectedTo->fd); }
void
setFd(StgForeignPtr fo,StgInt fp)
{ ((IOFileObject*)fo)->fd = fp;
return;
}
void
setConnectedTo(StgForeignPtr fo, StgForeignPtr 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(StgInt i)
{ __pushback_buf_size__ = (i > 0 ? i : 0); }
StgInt
getPushbackBufSize(void)
{ return (__pushback_buf_size__); }
/* Only ever called on line-buffered file objects */
StgInt
fill_up_line_buffer(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 ((count =
(
#ifdef USE_WINSOCK
fo->flags & FILEOBJ_WINSOCK ?
recv(fo->fd, p, len, 0) :
read(fo->fd, p, len))) <= 0 ) {
#else
read(fo->fd, p, len))) <= 0 ) {
#endif
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;
/* TODO: ipos doesn't change???? what's it for??? --SDM */
return (fo->bufWPtr - ipos);
}
|
