[project @ 1998-12-02 13:17:09 by simonm]
[ghc-hetmet.git] / ghc / lib / std / cbits / seekFile.c
1 /* 
2  * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
3  *
4  * $Id: seekFile.c,v 1.3 1998/12/02 13:27:53 simonm Exp $
5  *
6  * hSeek and hIsSeekable Runtime Support
7  */
8
9 #include "Rts.h"
10 #include "stgio.h"
11
12 #ifdef HAVE_SYS_TYPES_H
13 #include <sys/types.h>
14 #endif
15
16 #ifdef HAVE_SYS_STAT_H
17 #include <sys/stat.h>
18 #endif
19
20 /* Invoked by IO.hSeek only */
21 StgInt
22 seekFile(ptr, whence, size, d)
23 StgForeignPtr ptr;
24 StgInt whence;
25 StgInt size;
26 StgByteArray d;
27 {
28     IOFileObject* fo = (IOFileObject*)ptr;
29     struct stat sb;
30     off_t offset;
31     int posn_delta =0;
32     int rc = 0;
33
34     switch (whence) {
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; break; /* Should never happen, really */
39     }
40
41     /*
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.
45      */
46
47     switch (size) {
48     case -1:
49         offset = -*(StgInt *) d;
50         break;
51     case 0:
52         offset = 0;
53         break;
54     case 1:
55         offset = *(StgInt *) d;
56         break;
57     default:
58         ghc_errtype = ERR_INVALIDARGUMENT;
59         ghc_errstr = "offset out of range";
60         return -1;
61     }
62
63     /* If we're doing a relative seek, see if we cannot deal 
64      * with the request without flushing the buffer..
65      *
66      * Note: the wording in the report is vague here, but 
67      * we only avoid flushing on *input* buffers and *not* output ones.
68      */
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;
74        return 0;
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
80             buffering.
81          */
82         posn_delta = fo->bufWPtr - fo->bufRPtr;  /* number of chars left in the buffer */
83         if (posn_delta < 0) posn_delta=0;
84     }
85
86     /* If we cannot seek within our current buffer, flush it. */
87     rc = flushBuffer(ptr);
88     if (rc < 0) return rc;
89
90     /* Try to find out the file type & size for a physical file */
91     while (fstat(fo->fd, &sb) < 0) {
92         /* highly unlikely */
93         if (errno != EINTR) {
94             cvtErrno();
95             stdErrno();
96             return -1;
97         }
98     }
99     if (S_ISREG(sb.st_mode)) {
100         /* Verify that we are not seeking beyond end-of-file */
101         off_t posn;
102
103         switch (whence) {
104         case SEEK_SET:
105             posn = offset;
106             break;
107         case SEEK_CUR:
108             while ((posn = lseek(fo->fd, 0, SEEK_CUR)) == -1) {
109                 /* the possibility seems awfully remote */
110                 if (errno != EINTR) {
111                     cvtErrno();
112                     stdErrno();
113                     return -1;
114                 }
115             }
116             posn -= posn_delta;
117             posn += offset;
118             offset -= posn_delta; /* adjust the offset to include the buffer delta */
119             break;
120         case SEEK_END:
121             posn = (off_t)sb.st_size + offset;
122             break;
123         }
124         if (posn > sb.st_size) {
125             ghc_errtype = ERR_INVALIDARGUMENT;
126             ghc_errstr = "seek position beyond end of file";
127             return -1;
128         }
129     } else if (S_ISFIFO(sb.st_mode)) {
130         ghc_errtype = ERR_UNSUPPORTEDOPERATION;
131         ghc_errstr = "can't seek on a pipe";
132         return -1;
133     } else {
134         ghc_errtype = ERR_UNSUPPORTEDOPERATION;
135         ghc_errstr = "can't seek on a device";
136         return -1;
137     }
138     while ( lseek(fo->fd, offset, whence) == -1) {
139         if (errno != EINTR) {
140             cvtErrno();
141             stdErrno();
142             return -1;
143         }
144     }
145     /* Clear EOF */
146     FILEOBJ_CLEAR_EOF(fo);
147     return 0;
148 }
149
150 /* Invoked by IO.hSeek only */
151 StgInt
152 seekFile_int64(ptr, whence, d)
153 StgForeignPtr ptr;
154 StgInt whence;
155 StgInt64 d;
156 {
157     IOFileObject* fo = (IOFileObject*)ptr;
158     struct stat sb;
159     off_t offset = d;
160     int posn_delta =0;
161     int rc = 0;
162
163     switch (whence) {
164      case 0: whence=SEEK_SET; break;
165      case 1: whence=SEEK_CUR; break;
166      case 2: whence=SEEK_END; break;
167      default: whence=SEEK_SET; break; /* Should never happen, really */
168     }
169
170     /* If we're doing a relative seek, see if we cannot deal 
171      * with the request without flushing the buffer..
172      *
173      * Note: the wording in the report is vague here, but 
174      * we only avoid flushing on *input* buffers and *not* output ones.
175      */
176     if ( whence == SEEK_CUR &&
177          (FILEOBJ_READABLE(fo) && !FILEOBJ_WRITEABLE(fo) &&
178           (fo->bufRPtr + (int)offset) < fo->bufWPtr &&
179           (fo->bufRPtr + (int)offset) >= 0) ) { /* The input buffer case */
180        fo->bufRPtr += (int)offset;
181        return 0;
182     } else if ( whence == SEEK_CUR && (FILEOBJ_READABLE(fo) && !FILEOBJ_WRITEABLE(fo)) ) {
183          /* We're seeking outside the input buffer,
184             record delta so that we can adjust the file position
185             reported from the underlying fd to get
186             at the real position we're at when we take into account
187             buffering.
188          */
189         posn_delta = fo->bufWPtr - fo->bufRPtr;  /* number of chars left in the buffer */
190         if (posn_delta < 0) posn_delta=0;
191     }
192
193     /* If we cannot seek within our current buffer, flush it. */
194     rc = flushBuffer(ptr);
195     if (rc < 0) return rc;
196
197     /* Try to find out the file type & size for a physical file */
198     while (fstat(fo->fd, &sb) < 0) {
199         /* highly unlikely */
200         if (errno != EINTR) {
201             cvtErrno();
202             stdErrno();
203             return -1;
204         }
205     }
206     if (S_ISREG(sb.st_mode)) {
207         /* Verify that we are not seeking beyond end-of-file */
208         off_t posn;
209
210         switch (whence) {
211         case SEEK_SET:
212             posn = offset;
213             break;
214         case SEEK_CUR:
215             while ((posn = lseek(fo->fd, 0, SEEK_CUR)) == -1) {
216                 /* the possibility seems awfully remote */
217                 if (errno != EINTR) {
218                     cvtErrno();
219                     stdErrno();
220                     return -1;
221                 }
222             }
223             posn -= posn_delta;
224             posn += offset;
225             offset -= posn_delta; /* adjust the offset to include the buffer delta */
226             break;
227         case SEEK_END:
228             posn = (off_t)sb.st_size + offset;
229             break;
230         }
231         if (posn > sb.st_size) {
232             ghc_errtype = ERR_INVALIDARGUMENT;
233             ghc_errstr = "seek position beyond end of file";
234             return -1;
235         }
236     } else if (S_ISFIFO(sb.st_mode)) {
237         ghc_errtype = ERR_UNSUPPORTEDOPERATION;
238         ghc_errstr = "can't seek on a pipe";
239         return -1;
240     } else {
241         ghc_errtype = ERR_UNSUPPORTEDOPERATION;
242         ghc_errstr = "can't seek on a device";
243         return -1;
244     }
245     while ( lseek(fo->fd, offset, whence) == -1) {
246         if (errno != EINTR) {
247             cvtErrno();
248             stdErrno();
249             return -1;
250         }
251     }
252     /* Clear EOF */
253     FILEOBJ_CLEAR_EOF(fo);
254     return 0;
255 }
256
257 StgInt
258 seekFileP(ptr)
259 StgForeignPtr ptr;
260 {
261     IOFileObject* fo = (IOFileObject*)ptr;
262     struct stat sb;
263
264     /* Try to find out the file type */
265     while (fstat(fo->fd, &sb) < 0) {
266         /* highly unlikely */
267         if (errno != EINTR) {
268             cvtErrno();
269             stdErrno();
270             return -1;
271         }
272     }
273     /* Regular files are okay */
274     if (S_ISREG(sb.st_mode)) {
275         return 1;
276     } 
277     /* For now, everything else is not */
278     else {
279         return 0;
280     }
281 }