2 % (c) The GRASP/AQUA Project, Glasgow University, 1994
4 \subsection[seekFile.lc]{hSeek and hIsSeekable Runtime Support}
11 #ifdef HAVE_SYS_TYPES_H
12 #include <sys/types.h>
15 #ifdef HAVE_SYS_STAT_H
19 /* Invoked by IO.hSeek only */
21 seekFile(ptr, whence, size, d)
27 IOFileObject* fo = (IOFileObject*)ptr;
34 case 0: whence=SEEK_SET; break;
35 case 1: whence=SEEK_CUR; break;
36 case 2: whence=SEEK_END; break;
37 default: whence=SEEK_SET; break; /* Should never happen, really */
41 * We need to snatch the offset out of an MP_INT. The bits are there sans sign,
42 * which we pick up from our size parameter. If abs(size) is greater than 1,
43 * this integer is just too big.
48 offset = -*(StgInt *) d;
54 offset = *(StgInt *) d;
57 ghc_errtype = ERR_INVALIDARGUMENT;
58 ghc_errstr = "offset out of range";
62 /* If we're doing a relative seek, see if we cannot deal
63 * with the request without flushing the buffer..
65 * Note: the wording in the report is vague here, but
66 * we only avoid flushing on *input* buffers and *not* output ones.
68 if ( whence == SEEK_CUR &&
69 (FILEOBJ_READABLE(fo) && !FILEOBJ_WRITEABLE(fo) &&
70 (fo->bufRPtr + (int)offset) < fo->bufWPtr &&
71 (fo->bufRPtr + (int)offset) >= 0) ) { /* The input buffer case */
72 fo->bufRPtr += (int)offset;
74 } else if ( whence == SEEK_CUR && (FILEOBJ_READABLE(fo) && !FILEOBJ_WRITEABLE(fo)) ) {
75 /* We're seeking outside the input buffer,
76 record delta so that we can adjust the file position
77 reported from the underlying fd to get
78 at the real position we're at when we take into account
81 posn_delta = fo->bufWPtr - fo->bufRPtr; /* number of chars left in the buffer */
82 if (posn_delta < 0) posn_delta=0;
85 /* If we cannot seek within our current buffer, flush it. */
86 rc = flushBuffer(ptr);
87 if (rc < 0) return rc;
89 /* Try to find out the file type & size for a physical file */
90 while (fstat(fo->fd, &sb) < 0) {
98 if (S_ISREG(sb.st_mode)) {
99 /* Verify that we are not seeking beyond end-of-file */
107 while ((posn = lseek(fo->fd, 0, SEEK_CUR)) == -1) {
108 /* the possibility seems awfully remote */
109 if (errno != EINTR) {
117 offset -= posn_delta; /* adjust the offset to include the buffer delta */
120 posn = (off_t)sb.st_size + offset;
123 if (posn > sb.st_size) {
124 ghc_errtype = ERR_INVALIDARGUMENT;
125 ghc_errstr = "seek position beyond end of file";
128 } else if (S_ISFIFO(sb.st_mode)) {
129 ghc_errtype = ERR_UNSUPPORTEDOPERATION;
130 ghc_errstr = "can't seek on a pipe";
133 ghc_errtype = ERR_UNSUPPORTEDOPERATION;
134 ghc_errstr = "can't seek on a device";
137 while ( lseek(fo->fd, offset, whence) == -1) {
138 if (errno != EINTR) {
145 FILEOBJ_CLEAR_EOF(fo);
153 IOFileObject* fo = (IOFileObject*)ptr;
156 /* Try to find out the file type */
157 while (fstat(fo->fd, &sb) < 0) {
158 /* highly unlikely */
159 if (errno != EINTR) {
165 /* Regular files are okay */
166 if (S_ISREG(sb.st_mode)) {
169 /* For now, everything else is not */