File Coverage

Mmap.xs
Criterion Covered Total %
statement 20 20 100.0
branch n/a
condition n/a
subroutine n/a
pod n/a
total 20 20 100.0


line stmt bran cond sub pod time code
1             /* All the mmap() stuff is copied from Malcolm Beattie's Mmap.pm */
2              
3             #ifdef __cplusplus
4               extern "C" {
5             #endif
6              
7             #include "EXTERN.h"
8             #include "perl.h"
9             #include "XSUB.h"
10              
11             #ifdef __cplusplus
12               }
13             #endif
14              
15             #include <sys/mman.h>
16              
17             #ifndef MMAP_RETTYPE
18             # ifndef _POSIX_C_SOURCE
19             # define _POSIX_C_SOURCE 199309
20             # endif
21             # ifdef _POSIX_VERSION
22             # if _POSIX_VERSION >= 199309
23             # define MMAP_RETTYPE void *
24             # endif
25             # endif
26             #endif
27              
28             #ifndef MMAP_RETTYPE
29             # define MMAP_RETTYPE caddr_t
30             #endif
31              
32             #ifndef MAP_FAILED
33             # define MAP_FAILED ((caddr_t)-1)
34             #endif
35              
36             /* Required stuff for fcntl locking */
37             #include <fcntl.h>
38            
39             /* Stay backwards compatible */
40             #include "ppport.h"
41            
42             MODULE = Cache::Mmap PACKAGE = Cache::Mmap
43            
44             int
45             mmap(var,len,fh)
46             SV *var
47             size_t len
48             FILE *fh
49             int fd = NO_INIT
50             MMAP_RETTYPE addr = NO_INIT
51             PROTOTYPE: $$$
52             CODE:
53             /* XXX Use new perlio stuff to get fd */
54 9           fd=fileno(fh);
55            
56 9           addr=mmap(0,len,PROT_READ|PROT_WRITE,MAP_SHARED,fd,0);
57 9           if(addr==MAP_FAILED){
58             RETVAL=0;
59             }else{
60 9           SvUPGRADE(var,SVt_PV);
61 9           SvPVX(var)=(char*)addr;
62 9           SvCUR_set(var,len);
63 9           SvLEN_set(var,0);
64 9           SvPOK_only(var);
65             RETVAL=1;
66             }
67             OUTPUT:
68             RETVAL
69            
70             int
71             munmap(var)
72             SV *var
73             PROTOTYPE: $
74             CODE:
75 9           if(munmap((MMAP_RETTYPE)SvPVX(var),SvCUR(var))<0){
76             RETVAL=0;
77             }else{
78 9           SvREADONLY_off(var);
79 9           SvPVX(var)=0;
80 9           SvCUR_set(var,0);
81 9           SvLEN_set(var,0);
82 9           SvOK_off(var);
83             RETVAL=1;
84             }
85             OUTPUT:
86             RETVAL
87            
88             int
89             _lock_xs(fh,off,len,mode)
90             FILE *fh
91             off_t off
92             size_t len
93             int mode
94             int fd = NO_INIT
95             struct flock fl = NO_INIT
96             PROTOTYPE: $$$$
97             CODE:
98             /* XXX Use new perlio stuff to get fd */
99 321           fd=fileno(fh);
100 321           fl.l_whence=SEEK_SET;
101 321           fl.l_start=off;
102 321           fl.l_len=len;
103 321           fl.l_type=mode ? F_WRLCK : F_UNLCK;
104 321           RETVAL=fcntl(fd,F_SETLKW,&fl)>=0;
105            
106            
107             /* Define our own utf8::decode(), if we're on perl 5.6 */
108            
109             MODULE = Cache::Mmap PACKAGE = utf8
110            
111             #if (PERL_VERSION == 6)
112            
113             void
114             decode(SV *str)
115             PROTOTYPE: $
116             PPCODE:
117             SV *sv=ST(0);
118             int RETVAL;
119            
120             RETVAL=sv_utf8_decode(sv);
121             ST(0)=boolSV(RETVAL);
122             sv_2mortal(ST(0));
123             XSRETURN(1);
124            
125             #endif
126            
127