line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#ifdef __cplusplus |
2
|
|
|
|
|
|
|
extern "C" { |
3
|
|
|
|
|
|
|
#endif |
4
|
|
|
|
|
|
|
#include "EXTERN.h" |
5
|
|
|
|
|
|
|
#include "perl.h" |
6
|
|
|
|
|
|
|
#include "XSUB.h" |
7
|
|
|
|
|
|
|
#include |
8
|
|
|
|
|
|
|
#ifdef __cplusplus |
9
|
|
|
|
|
|
|
} |
10
|
|
|
|
|
|
|
#endif |
11
|
|
|
|
|
|
|
#include |
12
|
|
|
|
|
|
|
#include |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
#ifndef MMAP_RETTYPE |
15
|
|
|
|
|
|
|
#ifndef _POSIX_C_SOURCE |
16
|
|
|
|
|
|
|
#define _POSIX_C_SOURCE 199309 |
17
|
|
|
|
|
|
|
#endif |
18
|
|
|
|
|
|
|
#ifdef _POSIX_VERSION |
19
|
|
|
|
|
|
|
#if _POSIX_VERSION >= 199309 |
20
|
|
|
|
|
|
|
#define MMAP_RETTYPE void * |
21
|
|
|
|
|
|
|
#endif |
22
|
|
|
|
|
|
|
#endif |
23
|
|
|
|
|
|
|
#endif |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
#ifndef MMAP_RETTYPE |
26
|
|
|
|
|
|
|
#define MMAP_RETTYPE caddr_t |
27
|
|
|
|
|
|
|
#endif |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
#ifndef MAP_FAILED |
30
|
|
|
|
|
|
|
#define MAP_FAILED ((caddr_t)-1) |
31
|
|
|
|
|
|
|
#endif |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
static int |
34
|
0
|
|
|
|
|
|
not_here(s) |
35
|
|
|
|
|
|
|
char *s; |
36
|
|
|
|
|
|
|
{ |
37
|
0
|
|
|
|
|
|
croak("%s not implemented on this architecture", s); |
38
|
|
|
|
|
|
|
return -1; |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
static double |
42
|
4
|
|
|
|
|
|
constant(name, arg) |
43
|
|
|
|
|
|
|
char *name; |
44
|
|
|
|
|
|
|
int arg; |
45
|
|
|
|
|
|
|
{ |
46
|
4
|
|
|
|
|
|
errno = 0; |
47
|
4
|
|
|
|
|
|
switch (*name) { |
48
|
|
|
|
|
|
|
case 'M': |
49
|
2
|
50
|
|
|
|
|
if (strEQ(name, "MAP_ANON")) |
50
|
|
|
|
|
|
|
#ifdef MAP_ANON |
51
|
0
|
|
|
|
|
|
return MAP_ANON; |
52
|
|
|
|
|
|
|
#else |
53
|
|
|
|
|
|
|
goto not_there; |
54
|
|
|
|
|
|
|
#endif |
55
|
2
|
50
|
|
|
|
|
if (strEQ(name, "MAP_ANONYMOUS")) |
56
|
|
|
|
|
|
|
#ifdef MAP_ANONYMOUS |
57
|
0
|
|
|
|
|
|
return MAP_ANONYMOUS; |
58
|
|
|
|
|
|
|
#else |
59
|
|
|
|
|
|
|
goto not_there; |
60
|
|
|
|
|
|
|
#endif |
61
|
2
|
50
|
|
|
|
|
if (strEQ(name, "MAP_FILE")) |
62
|
|
|
|
|
|
|
#ifdef MAP_FILE |
63
|
0
|
|
|
|
|
|
return MAP_FILE; |
64
|
|
|
|
|
|
|
#else |
65
|
|
|
|
|
|
|
goto not_there; |
66
|
|
|
|
|
|
|
#endif |
67
|
2
|
50
|
|
|
|
|
if (strEQ(name, "MAP_PRIVATE")) |
68
|
|
|
|
|
|
|
#ifdef MAP_PRIVATE |
69
|
0
|
|
|
|
|
|
return MAP_PRIVATE; |
70
|
|
|
|
|
|
|
#else |
71
|
|
|
|
|
|
|
goto not_there; |
72
|
|
|
|
|
|
|
#endif |
73
|
2
|
100
|
|
|
|
|
if (strEQ(name, "MAP_SHARED")) |
74
|
|
|
|
|
|
|
#ifdef MAP_SHARED |
75
|
1
|
|
|
|
|
|
return MAP_SHARED; |
76
|
|
|
|
|
|
|
#else |
77
|
|
|
|
|
|
|
goto not_there; |
78
|
|
|
|
|
|
|
#endif |
79
|
1
|
50
|
|
|
|
|
if (strEQ(name, "MAP_LOCKED")) |
80
|
|
|
|
|
|
|
#ifdef MAP_LOCKED |
81
|
0
|
|
|
|
|
|
return MAP_LOCKED; |
82
|
|
|
|
|
|
|
#else |
83
|
|
|
|
|
|
|
goto not_there; |
84
|
|
|
|
|
|
|
#endif |
85
|
1
|
50
|
|
|
|
|
if (strEQ(name, "MAP_NORESERVE")) |
86
|
|
|
|
|
|
|
#ifdef MAP_NORESERVE |
87
|
0
|
|
|
|
|
|
return MAP_NORESERVE; |
88
|
|
|
|
|
|
|
#else |
89
|
|
|
|
|
|
|
goto not_there; |
90
|
|
|
|
|
|
|
#endif |
91
|
1
|
50
|
|
|
|
|
if (strEQ(name, "MAP_POPULATE")) |
92
|
|
|
|
|
|
|
#ifdef MAP_POPULATE |
93
|
1
|
|
|
|
|
|
return MAP_POPULATE; |
94
|
|
|
|
|
|
|
#else |
95
|
|
|
|
|
|
|
goto not_there; |
96
|
|
|
|
|
|
|
#endif |
97
|
0
|
0
|
|
|
|
|
if (strEQ(name, "MAP_HUGETLB")) |
98
|
|
|
|
|
|
|
#ifdef MAP_HUGETLB |
99
|
0
|
|
|
|
|
|
return MAP_HUGETLB; |
100
|
|
|
|
|
|
|
#else |
101
|
|
|
|
|
|
|
goto not_there; |
102
|
|
|
|
|
|
|
#endif |
103
|
0
|
0
|
|
|
|
|
if (strEQ(name, "MAP_HUGE_2MB")) |
104
|
|
|
|
|
|
|
#ifdef MAP_HUGE_2MB |
105
|
|
|
|
|
|
|
return MAP_HUGE_2MB; |
106
|
|
|
|
|
|
|
#else |
107
|
0
|
|
|
|
|
|
goto not_there; |
108
|
|
|
|
|
|
|
#endif |
109
|
0
|
0
|
|
|
|
|
if (strEQ(name, "MAP_HUGE_1GB")) |
110
|
|
|
|
|
|
|
#ifdef MAP_HUGE_1GB |
111
|
|
|
|
|
|
|
return MAP_HUGE_1GB; |
112
|
|
|
|
|
|
|
#else |
113
|
0
|
|
|
|
|
|
goto not_there; |
114
|
|
|
|
|
|
|
#endif |
115
|
0
|
|
|
|
|
|
break; |
116
|
|
|
|
|
|
|
case 'P': |
117
|
2
|
50
|
|
|
|
|
if (strEQ(name, "PROT_EXEC")) |
118
|
|
|
|
|
|
|
#ifdef PROT_EXEC |
119
|
0
|
|
|
|
|
|
return PROT_EXEC; |
120
|
|
|
|
|
|
|
#else |
121
|
|
|
|
|
|
|
goto not_there; |
122
|
|
|
|
|
|
|
#endif |
123
|
2
|
50
|
|
|
|
|
if (strEQ(name, "PROT_NONE")) |
124
|
|
|
|
|
|
|
#ifdef PROT_NONE |
125
|
0
|
|
|
|
|
|
return PROT_NONE; |
126
|
|
|
|
|
|
|
#else |
127
|
|
|
|
|
|
|
goto not_there; |
128
|
|
|
|
|
|
|
#endif |
129
|
2
|
100
|
|
|
|
|
if (strEQ(name, "PROT_READ")) |
130
|
|
|
|
|
|
|
#ifdef PROT_READ |
131
|
1
|
|
|
|
|
|
return PROT_READ; |
132
|
|
|
|
|
|
|
#else |
133
|
|
|
|
|
|
|
goto not_there; |
134
|
|
|
|
|
|
|
#endif |
135
|
1
|
50
|
|
|
|
|
if (strEQ(name, "PROT_WRITE")) |
136
|
|
|
|
|
|
|
#ifdef PROT_WRITE |
137
|
1
|
|
|
|
|
|
return PROT_WRITE; |
138
|
|
|
|
|
|
|
#else |
139
|
|
|
|
|
|
|
goto not_there; |
140
|
|
|
|
|
|
|
#endif |
141
|
0
|
|
|
|
|
|
break; |
142
|
|
|
|
|
|
|
default: |
143
|
0
|
|
|
|
|
|
break; |
144
|
|
|
|
|
|
|
} |
145
|
0
|
|
|
|
|
|
errno = EINVAL; |
146
|
0
|
|
|
|
|
|
return 0; |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
not_there: |
149
|
0
|
|
|
|
|
|
errno = ENOENT; |
150
|
0
|
|
|
|
|
|
return 0; |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
static size_t pagesize = 0; |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
#if _FILE_OFFSET_BITS > 32 |
157
|
|
|
|
|
|
|
#define get_off(a) (atoll(a)) |
158
|
|
|
|
|
|
|
#else |
159
|
|
|
|
|
|
|
#define get_off(a) (atoi(a)) |
160
|
|
|
|
|
|
|
#endif |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
MODULE = Sys::Mmap PACKAGE = Sys::Mmap |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
double |
167
|
|
|
|
|
|
|
constant(name,arg) |
168
|
|
|
|
|
|
|
char * name |
169
|
|
|
|
|
|
|
int arg |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
SV * |
172
|
|
|
|
|
|
|
hardwire(var, addr, len) |
173
|
|
|
|
|
|
|
SV * var |
174
|
|
|
|
|
|
|
IV addr |
175
|
|
|
|
|
|
|
size_t len |
176
|
|
|
|
|
|
|
PROTOTYPE: $$$ |
177
|
|
|
|
|
|
|
CODE: |
178
|
0
|
|
|
|
|
|
ST(0) = &PL_sv_undef; |
179
|
0
|
0
|
|
|
|
|
SvUPGRADE(var, SVt_PV); |
180
|
0
|
|
|
|
|
|
SvPVX(var) = (char *) addr; |
181
|
0
|
|
|
|
|
|
SvCUR_set(var, len); |
182
|
0
|
|
|
|
|
|
SvLEN_set(var, 0); |
183
|
0
|
|
|
|
|
|
SvPOK_only(var); |
184
|
|
|
|
|
|
|
/*printf("ok, that var is now stuck at addr %lx\n", addr);*/ |
185
|
0
|
|
|
|
|
|
ST(0) = &PL_sv_yes; |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
SV * |
190
|
|
|
|
|
|
|
mmap(var, len, prot, flags, fh = 0, off_string) |
191
|
|
|
|
|
|
|
SV * var |
192
|
|
|
|
|
|
|
size_t len |
193
|
|
|
|
|
|
|
int prot |
194
|
|
|
|
|
|
|
int flags |
195
|
|
|
|
|
|
|
FILE * fh |
196
|
|
|
|
|
|
|
SV * off_string |
197
|
|
|
|
|
|
|
int fd = NO_INIT |
198
|
|
|
|
|
|
|
MMAP_RETTYPE addr = NO_INIT |
199
|
|
|
|
|
|
|
off_t slop = NO_INIT |
200
|
|
|
|
|
|
|
off_t off = NO_INIT |
201
|
|
|
|
|
|
|
PROTOTYPE: $$$$*;$ |
202
|
|
|
|
|
|
|
CODE: |
203
|
|
|
|
|
|
|
|
204
|
5
|
50
|
|
|
|
|
if(!SvTRUE(off_string)) { |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
205
|
0
|
|
|
|
|
|
off = 0; |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
else { |
208
|
5
|
50
|
|
|
|
|
off = get_off(SvPVbyte_nolen(off_string)); |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
|
211
|
5
|
100
|
|
|
|
|
if(off < 0) { |
212
|
1
|
50
|
|
|
|
|
croak("mmap: Cannot operate on a negative offset (%s) ", SvPVbyte_nolen(off_string)); |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
4
|
|
|
|
|
|
ST(0) = &PL_sv_undef; |
216
|
4
|
50
|
|
|
|
|
if(flags&MAP_ANON) { |
217
|
0
|
|
|
|
|
|
fd = -1; |
218
|
0
|
0
|
|
|
|
|
if (!len) { |
219
|
|
|
|
|
|
|
/* i WANT to return undef and set $! but perlxs and perlxstut dont tell me how... waa! */ |
220
|
0
|
|
|
|
|
|
croak("mmap: MAP_ANON specified, but no length specified. cannot infer length from file"); |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
} else { |
223
|
4
|
|
|
|
|
|
fd = fileno(fh); |
224
|
4
|
50
|
|
|
|
|
if (fd < 0) { |
225
|
0
|
|
|
|
|
|
croak("mmap: file not open or does not have associated fileno"); |
226
|
|
|
|
|
|
|
} |
227
|
4
|
100
|
|
|
|
|
if (!len) { |
228
|
|
|
|
|
|
|
struct stat st; |
229
|
3
|
50
|
|
|
|
|
if (fstat(fd, &st) == -1) { |
230
|
0
|
|
|
|
|
|
croak("mmap: no len provided, fstat failed, unable to infer length"); |
231
|
|
|
|
|
|
|
} |
232
|
3
|
|
|
|
|
|
len = st.st_size; |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
4
|
100
|
|
|
|
|
if (pagesize == 0) { |
237
|
1
|
|
|
|
|
|
pagesize = getpagesize(); |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
|
240
|
4
|
|
|
|
|
|
slop = (size_t) off % pagesize; |
241
|
|
|
|
|
|
|
|
242
|
4
|
|
|
|
|
|
addr = mmap(0, len + slop, prot, flags, fd, off - slop); |
243
|
4
|
50
|
|
|
|
|
if (addr == MAP_FAILED) { |
244
|
0
|
|
|
|
|
|
croak("mmap: mmap call failed: errno: %d errmsg: %s ", errno, strerror(errno)); |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
#if PERL_VERSION >= 20 |
247
|
|
|
|
|
|
|
|
248
|
4
|
50
|
|
|
|
|
if (SvIsCOW(var)) { |
249
|
0
|
|
|
|
|
|
sv_force_normal_flags(var, 0); |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
#endif |
252
|
|
|
|
|
|
|
|
253
|
4
|
100
|
|
|
|
|
SvUPGRADE(var, SVt_PV); |
254
|
4
|
100
|
|
|
|
|
if (!(prot & PROT_WRITE)) |
255
|
2
|
|
|
|
|
|
SvREADONLY_on(var); |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
/* would sv_usepvn() be cleaner/better/different? would still try to realloc... */ |
258
|
4
|
|
|
|
|
|
SvPVX(var) = (char *) addr + slop; |
259
|
4
|
|
|
|
|
|
SvCUR_set(var, len); |
260
|
4
|
|
|
|
|
|
SvLEN_set(var, slop); |
261
|
4
|
|
|
|
|
|
SvPOK_only(var); |
262
|
4
|
|
|
|
|
|
ST(0) = sv_2mortal(newSVnv((IV) addr)); |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
SV * |
265
|
|
|
|
|
|
|
munmap(var) |
266
|
|
|
|
|
|
|
SV * var |
267
|
|
|
|
|
|
|
PROTOTYPE: $ |
268
|
|
|
|
|
|
|
CODE: |
269
|
18
|
|
|
|
|
|
ST(0) = &PL_sv_undef; |
270
|
|
|
|
|
|
|
/* XXX refrain from dumping core if this var wasnt previously mmap'd */ |
271
|
18
|
100
|
|
|
|
|
if(!SvOK(var)) { /* Detect if variable is undef */ |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
272
|
3
|
|
|
|
|
|
croak("undef variable not unmappable"); |
273
|
|
|
|
|
|
|
return; |
274
|
|
|
|
|
|
|
} |
275
|
15
|
100
|
|
|
|
|
if(SvTYPE(var) < SVt_PV || SvTYPE(var) > SVt_PVMG) { |
|
|
50
|
|
|
|
|
|
276
|
7
|
|
|
|
|
|
croak("variable is not a string, type is: %d", SvTYPE(var)); |
277
|
|
|
|
|
|
|
return; |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
|
280
|
8
|
100
|
|
|
|
|
if (munmap((MMAP_RETTYPE) SvPVX(var) - SvLEN(var), SvCUR(var) + SvLEN(var)) == -1) { |
281
|
4
|
|
|
|
|
|
croak("munmap failed! errno %d %s\n", errno, strerror(errno)); |
282
|
|
|
|
|
|
|
return; |
283
|
|
|
|
|
|
|
} |
284
|
4
|
|
|
|
|
|
SvREADONLY_off(var); |
285
|
4
|
|
|
|
|
|
SvPVX(var) = 0; |
286
|
4
|
|
|
|
|
|
SvCUR_set(var, 0); |
287
|
4
|
|
|
|
|
|
SvLEN_set(var, 0); |
288
|
4
|
50
|
|
|
|
|
SvOK_off(var); |
289
|
4
|
|
|
|
|
|
ST(0) = &PL_sv_yes; |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
void |
292
|
|
|
|
|
|
|
DESTROY(var) |
293
|
|
|
|
|
|
|
SV * var |
294
|
|
|
|
|
|
|
PROTOTYPE: $ |
295
|
|
|
|
|
|
|
CODE: |
296
|
|
|
|
|
|
|
/* XXX refrain from dumping core if this var wasnt previously mmap'd*/ |
297
|
0
|
0
|
|
|
|
|
if (munmap((MMAP_RETTYPE) SvPVX(var), SvCUR(var)) == -1) { |
298
|
0
|
|
|
|
|
|
croak("munmap failed! errno %d %s\n", errno, strerror(errno)); |
299
|
|
|
|
|
|
|
return; |
300
|
|
|
|
|
|
|
} |
301
|
0
|
|
|
|
|
|
SvREADONLY_off(var); |
302
|
0
|
|
|
|
|
|
SvPVX(var) = 0; |
303
|
0
|
|
|
|
|
|
SvCUR_set(var, 0); |
304
|
0
|
|
|
|
|
|
SvLEN_set(var, 0); |
305
|
0
|
0
|
|
|
|
|
SvOK_off(var); |
306
|
|
|
|
|
|
|
/* printf("destroy ran fine, thanks\n"); */ |
307
|
0
|
|
|
|
|
|
ST(0) = &PL_sv_yes; |