2 * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
4 * $Id: seekFile.c,v 1.4 1999/09/19 19:25:24 sof Exp $
6 * hSeek and hIsSeekable Runtime Support
12 #ifdef HAVE_SYS_TYPES_H
13 #include <sys/types.h>
16 #ifdef HAVE_SYS_STAT_H
20 /* Invoked by IO.hSeek only */
22 seekFile(ptr, whence, size, d)
28 IOFileObject* fo = (IOFileObject*)ptr;
35 case 0: whence=SEEK_SET; break;
36 case 1: whence=SEEK_CUR; break;
37 case 2: whence=SEEK_END; break;
38 default: whence=SEEK_SET; /* Should never happen, really */
42 * We need to snatch the offset out of an MP_INT. The bits are there sans sign,
43 * which we pick up from our size parameter. If abs(size) is greater than 1,
44 * this integer is just too big.
49 offset = -*(StgInt *) d;
55 offset = *(StgInt *) d;
58 ghc_errtype = ERR_INVALIDARGUMENT;
59 ghc_errstr = "offset out of range";
63 /* If we're doing a relative seek, see if we cannot deal
64 * with the request without flushing the buffer..
66 * Note: the wording in the report is vague here, but
67 * we only avoid flushing on *input* buffers and *not* output ones.
69 if ( whence == SEEK_CUR &&
70 (FILEOBJ_READABLE(fo) && !FILEOBJ_WRITEABLE(fo) &&
71 (fo->bufRPtr + (int)offset) < fo->bufWPtr &&
72 (fo->bufRPtr + (int)offset) >= 0) ) { /* The input buffer case */
73 fo->bufRPtr += (int)offset;
75 } else if ( whence == SEEK_CUR && (FILEOBJ_READABLE(fo) && !FILEOBJ_WRITEABLE(fo)) ) {
76 /* We're seeking outside the input buffer,
77 record delta so that we can adjust the file position
78 reported from the underlying fd to get
79 at the real position we're at when we take into account
82 posn_delta = fo->bufWPtr - fo->bufRPtr; /* number of chars left in the buffer */
83 if (posn_delta < 0) posn_delta=0;
86 /* If we cannot seek within our current buffer, flush it. */
87 rc = flushBuffer(ptr);
88 if (rc < 0) return rc;
90 /* Try to find out the file type */
91 while (fstat(fo->fd, &sb) < 0) {
99 if (S_ISFIFO(sb.st_mode)) {
100 ghc_errtype = ERR_UNSUPPORTEDOPERATION;
101 ghc_errstr = "can't seek on a pipe";
104 while ( lseek(fo->fd, offset, whence) == -1) {
105 if (errno != EINTR) {
112 FILEOBJ_CLEAR_EOF(fo);
116 /* Invoked by IO.hSeek only */
118 seekFile_int64(ptr, whence, d)
123 IOFileObject* fo = (IOFileObject*)ptr;
130 case 0: whence=SEEK_SET; break;
131 case 1: whence=SEEK_CUR; break;
132 case 2: whence=SEEK_END; break;
133 default: whence=SEEK_SET; break; /* Should never happen, really */
136 /* If we're doing a relative seek, see if we cannot deal
137 * with the request without flushing the buffer..
139 * Note: the wording in the report is vague here, but
140 * we only avoid flushing on *input* buffers and *not* output ones.
142 if ( whence == SEEK_CUR &&
143 (FILEOBJ_READABLE(fo) && !FILEOBJ_WRITEABLE(fo) &&
144 (fo->bufRPtr + (int)offset) < fo->bufWPtr &&
145 (fo->bufRPtr + (int)offset) >= 0) ) { /* The input buffer case */
146 fo->bufRPtr += (int)offset;
148 } else if ( whence == SEEK_CUR && (FILEOBJ_READABLE(fo) && !FILEOBJ_WRITEABLE(fo)) ) {
149 /* We're seeking outside the input buffer,
150 record delta so that we can adjust the file position
151 reported from the underlying fd to get
152 at the real position we're at when we take into account
155 posn_delta = fo->bufWPtr - fo->bufRPtr; /* number of chars left in the buffer */
156 if (posn_delta < 0) posn_delta=0;
159 /* If we cannot seek within our current buffer, flush it. */
160 rc = flushBuffer(ptr);
161 if (rc < 0) return rc;
163 /* Try to find out the file type & size for a physical file */
164 while (fstat(fo->fd, &sb) < 0) {
165 /* highly unlikely */
166 if (errno != EINTR) {
172 if (S_ISFIFO(sb.st_mode)) {
173 ghc_errtype = ERR_UNSUPPORTEDOPERATION;
174 ghc_errstr = "can't seek on a pipe";
177 while ( lseek(fo->fd, offset, whence) == -1) {
178 if (errno != EINTR) {
185 FILEOBJ_CLEAR_EOF(fo);
193 IOFileObject* fo = (IOFileObject*)ptr;
196 /* Try to find out the file type */
197 while (fstat(fo->fd, &sb) < 0) {
198 /* highly unlikely */
199 if (errno != EINTR) {
205 /* Pipes are not okay.. */
206 if (S_ISFIFO(sb.st_mode)) {
209 /* ..for now, everything else is */