File Coverage

Mmap.xs
Criterion Covered Total %
statement 57 103 55.3
branch 51 114 44.7
condition n/a
subroutine n/a
pod n/a
total 108 217 49.7


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;