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
|
%
% (c) The GRASP/AQUA Project, Glasgow University, 1994
%
\subsection[seekFile.lc]{hSeek and hIsSeekable Runtime Support}
\begin{code}
#include "rtsdefs.h"
#include "stgio.h"
#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
#endif
#ifdef HAVE_SYS_STAT_H
#include <sys/stat.h>
#endif
StgInt
seekFile(fp, whence, size, d)
StgAddr fp;
StgInt whence;
StgInt size;
StgByteArray d;
{
struct stat sb;
long int offset;
/*
* We need to snatch the offset out of an MP_INT. The bits are there sans sign,
* which we pick up from our size parameter. If abs(size) is greater than 1,
* this integer is just too big.
*/
switch (size) {
case -1:
offset = -*(StgInt *) d;
break;
case 0:
offset = 0;
break;
case 1:
offset = *(StgInt *) d;
break;
default:
ghc_errtype = ERR_INVALIDARGUMENT;
ghc_errstr = "offset out of range";
return -1;
}
/* Try to find out the file type & size for a physical file */
while (fstat(fileno((FILE *) fp), &sb) < 0) {
/* highly unlikely */
if (errno != EINTR) {
cvtErrno();
stdErrno();
return -1;
}
}
if (S_ISREG(sb.st_mode)) {
/* Verify that we are not seeking beyond end-of-file */
int posn;
switch (whence) {
case SEEK_SET:
posn = offset;
break;
case SEEK_CUR:
while ((posn = ftell((FILE *) fp)) == -1) {
/* the possibility seems awfully remote */
if (errno != EINTR) {
cvtErrno();
stdErrno();
return -1;
}
}
posn += offset;
break;
case SEEK_END:
posn = sb.st_size + offset;
break;
}
if (posn > sb.st_size) {
ghc_errtype = ERR_INVALIDARGUMENT;
ghc_errstr = "seek position beyond end of file";
return -1;
}
} else if (S_ISFIFO(sb.st_mode)) {
ghc_errtype = ERR_UNSUPPORTEDOPERATION;
ghc_errstr = "can't seek on a pipe";
return -1;
} else {
ghc_errtype = ERR_UNSUPPORTEDOPERATION;
ghc_errstr = "can't seek on a device";
return -1;
}
while (fseek((FILE *) fp, offset, whence) != 0) {
if (errno != EINTR) {
cvtErrno();
stdErrno();
return -1;
}
}
return 0;
}
StgInt
seekFileP(fp)
StgAddr fp;
{
struct stat sb;
/* Try to find out the file type */
while (fstat(fileno((FILE *) fp), &sb) < 0) {
/* highly unlikely */
if (errno != EINTR) {
cvtErrno();
stdErrno();
return -1;
}
}
/* Regular files are okay */
if (S_ISREG(sb.st_mode)) {
return 1;
}
/* For now, everything else is not */
else {
return 0;
}
}
\end{code}
|