1 /* 2 * ex: set ts=8 sts=4 sw=4 et: 3 */ 4 5 #define PERL_NO_GET_CONTEXT 6 #include "EXTERN.h" 7 #include "perl.h" 8 #include "XSUB.h" 9 10 #if defined(PERLIO_LAYERS) && defined(HAS_MMAP) 11 12 #include "perliol.h" 13 #include <sys/mman.h> 14 15 /* 16 * mmap as "buffer" layer 17 */ 18 19 typedef struct { 20 PerlIOBuf base; /* PerlIOBuf stuff */ 21 Mmap_t mptr; /* Mapped address */ 22 Size_t len; /* mapped length */ 23 STDCHAR *bbuf; /* malloced buffer if map fails */ 24 } PerlIOMmap; 25 26 static IV 27 PerlIOMmap_map(pTHX_ PerlIO *f) 28 { 29 PerlIOMmap * const m = PerlIOSelf(f, PerlIOMmap); 30 const IV flags = PerlIOBase(f)->flags; 31 IV code = 0; 32 if (m->len) 33 abort(); 34 if (flags & PERLIO_F_CANREAD) { 35 PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf); 36 Stat_t st; 37 const int fd = PerlIO_fileno(f); 38 if (fd < 0) { 39 SETERRNO(EBADF,RMS_IFI); 40 return -1; 41 } 42 code = Fstat(fd, &st); 43 if (code == 0 && S_ISREG(st.st_mode)) { 44 SSize_t len = st.st_size - b->posn; 45 if (len > 0) { 46 Off_t posn; 47 if (PL_mmap_page_size <= 0) 48 Perl_croak(aTHX_ "panic: bad pagesize %" IVdf, 49 PL_mmap_page_size); 50 if (b->posn < 0) { 51 /* 52 * This is a hack - should never happen - open should 53 * have set it ! 54 */ 55 b->posn = PerlIO_tell(PerlIONext(f)); 56 } 57 posn = (b->posn / PL_mmap_page_size) * PL_mmap_page_size; 58 len = st.st_size - posn; 59 m->mptr = (Mmap_t)mmap(NULL, len, PROT_READ, MAP_SHARED, fd, posn); 60 if (m->mptr && m->mptr != (Mmap_t) - 1) { 61 #if 0 && defined(HAS_MADVISE) && defined(MADV_SEQUENTIAL) 62 madvise(m->mptr, len, MADV_SEQUENTIAL); 63 #endif 64 #if 0 && defined(HAS_MADVISE) && defined(MADV_WILLNEED) 65 madvise(m->mptr, len, MADV_WILLNEED); 66 #endif 67 PerlIOBase(f)->flags = 68 (flags & ~PERLIO_F_EOF) | PERLIO_F_RDBUF; 69 b->end = ((STDCHAR *) m->mptr) + len; 70 b->buf = ((STDCHAR *) m->mptr) + (b->posn - posn); 71 b->ptr = b->buf; 72 m->len = len; 73 } 74 else { 75 b->buf = NULL; 76 } 77 } 78 else { 79 PerlIOBase(f)->flags = 80 flags | PERLIO_F_EOF | PERLIO_F_RDBUF; 81 b->buf = NULL; 82 b->ptr = b->end = b->ptr; 83 code = -1; 84 } 85 } 86 } 87 return code; 88 } 89 90 static IV 91 PerlIOMmap_unmap(pTHX_ PerlIO *f) 92 { 93 PerlIOMmap * const m = PerlIOSelf(f, PerlIOMmap); 94 IV code = 0; 95 if (m->len) { 96 PerlIOBuf * const b = &m->base; 97 if (b->buf) { 98 /* The munmap address argument is tricky: depending on the 99 * standard it is either "void *" or "caddr_t" (which is 100 * usually "char *" (signed or unsigned). If we cast it 101 * to "void *", those that have it caddr_t and an uptight 102 * C++ compiler, will freak out. But casting it as char* 103 * should work. Maybe. (Using Mmap_t figured out by 104 * Configure doesn't always work, apparently.) */ 105 code = munmap((char*)m->mptr, m->len); 106 b->buf = NULL; 107 m->len = 0; 108 m->mptr = NULL; 109 if (PerlIO_seek(PerlIONext(f), b->posn, SEEK_SET) != 0) 110 code = -1; 111 } 112 b->ptr = b->end = b->buf; 113 PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF); 114 } 115 return code; 116 } 117 118 static STDCHAR * 119 PerlIOMmap_get_base(pTHX_ PerlIO *f) 120 { 121 PerlIOMmap * const m = PerlIOSelf(f, PerlIOMmap); 122 PerlIOBuf * const b = &m->base; 123 if (b->buf && (PerlIOBase(f)->flags & PERLIO_F_RDBUF)) { 124 /* 125 * Already have a readbuffer in progress 126 */ 127 return b->buf; 128 } 129 if (b->buf) { 130 /* 131 * We have a write buffer or flushed PerlIOBuf read buffer 132 */ 133 m->bbuf = b->buf; /* save it in case we need it again */ 134 b->buf = NULL; /* Clear to trigger below */ 135 } 136 if (!b->buf) { 137 PerlIOMmap_map(aTHX_ f); /* Try and map it */ 138 if (!b->buf) { 139 /* 140 * Map did not work - recover PerlIOBuf buffer if we have one 141 */ 142 b->buf = m->bbuf; 143 } 144 } 145 b->ptr = b->end = b->buf; 146 if (b->buf) 147 return b->buf; 148 return PerlIOBuf_get_base(aTHX_ f); 149 } 150 151 static SSize_t 152 PerlIOMmap_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count) 153 { 154 PerlIOMmap * const m = PerlIOSelf(f, PerlIOMmap); 155 PerlIOBuf * const b = &m->base; 156 if (PerlIOBase(f)->flags & PERLIO_F_WRBUF) 157 PerlIO_flush(f); 158 if (b->ptr && (b->ptr - count) >= b->buf 159 && memEQ(b->ptr - count, vbuf, count)) { 160 b->ptr -= count; 161 PerlIOBase(f)->flags &= ~PERLIO_F_EOF; 162 return count; 163 } 164 if (m->len) { 165 /* 166 * Loose the unwritable mapped buffer 167 */ 168 PerlIO_flush(f); 169 /* 170 * If flush took the "buffer" see if we have one from before 171 */ 172 if (!b->buf && m->bbuf) 173 b->buf = m->bbuf; 174 if (!b->buf) { 175 PerlIOBuf_get_base(aTHX_ f); 176 m->bbuf = b->buf; 177 } 178 } 179 return PerlIOBuf_unread(aTHX_ f, vbuf, count); 180 } 181 182 static SSize_t 183 PerlIOMmap_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count) 184 { 185 PerlIOMmap * const m = PerlIOSelf(f, PerlIOMmap); 186 PerlIOBuf * const b = &m->base; 187 188 if (!b->buf || !(PerlIOBase(f)->flags & PERLIO_F_WRBUF)) { 189 /* 190 * No, or wrong sort of, buffer 191 */ 192 if (m->len) { 193 if (PerlIOMmap_unmap(aTHX_ f) != 0) 194 return 0; 195 } 196 /* 197 * If unmap took the "buffer" see if we have one from before 198 */ 199 if (!b->buf && m->bbuf) 200 b->buf = m->bbuf; 201 if (!b->buf) { 202 PerlIOBuf_get_base(aTHX_ f); 203 m->bbuf = b->buf; 204 } 205 } 206 return PerlIOBuf_write(aTHX_ f, vbuf, count); 207 } 208 209 static IV 210 PerlIOMmap_flush(pTHX_ PerlIO *f) 211 { 212 PerlIOMmap * const m = PerlIOSelf(f, PerlIOMmap); 213 PerlIOBuf * const b = &m->base; 214 IV code = PerlIOBuf_flush(aTHX_ f); 215 /* 216 * Now we are "synced" at PerlIOBuf level 217 */ 218 if (b->buf) { 219 if (m->len) { 220 /* 221 * Unmap the buffer 222 */ 223 if (PerlIOMmap_unmap(aTHX_ f) != 0) 224 code = -1; 225 } 226 else { 227 /* 228 * We seem to have a PerlIOBuf buffer which was not mapped 229 * remember it in case we need one later 230 */ 231 m->bbuf = b->buf; 232 } 233 } 234 return code; 235 } 236 237 static IV 238 PerlIOMmap_fill(pTHX_ PerlIO *f) 239 { 240 PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf); 241 IV code = PerlIO_flush(f); 242 if (code == 0 && !b->buf) { 243 code = PerlIOMmap_map(aTHX_ f); 244 } 245 if (code == 0 && !(PerlIOBase(f)->flags & PERLIO_F_RDBUF)) { 246 code = PerlIOBuf_fill(aTHX_ f); 247 } 248 return code; 249 } 250 251 static PerlIO * 252 PerlIOMmap_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags) 253 { 254 return PerlIOBase_dup(aTHX_ f, o, param, flags); 255 } 256 257 258 static PERLIO_FUNCS_DECL(PerlIO_mmap) = { 259 sizeof(PerlIO_funcs), 260 "mmap", 261 sizeof(PerlIOMmap), 262 PERLIO_K_BUFFERED|PERLIO_K_RAW, 263 PerlIOBuf_pushed, 264 PerlIOBuf_popped, 265 PerlIOBuf_open, 266 PerlIOBase_binmode, /* binmode */ 267 NULL, 268 PerlIOBase_fileno, 269 PerlIOMmap_dup, 270 PerlIOBuf_read, 271 PerlIOMmap_unread, 272 PerlIOMmap_write, 273 PerlIOBuf_seek, 274 PerlIOBuf_tell, 275 PerlIOBuf_close, 276 PerlIOMmap_flush, 277 PerlIOMmap_fill, 278 PerlIOBase_eof, 279 PerlIOBase_error, 280 PerlIOBase_clearerr, 281 PerlIOBase_setlinebuf, 282 PerlIOMmap_get_base, 283 PerlIOBuf_bufsiz, 284 PerlIOBuf_get_ptr, 285 PerlIOBuf_get_cnt, 286 PerlIOBuf_set_ptrcnt, 287 }; 288 289 #endif /* Layers available */ 290 291 MODULE = PerlIO::mmap PACKAGE = PerlIO::mmap 292 293 PROTOTYPES: DISABLE 294 295 BOOT: 296 { 297 #if defined(PERLIO_LAYERS) && defined(HAS_MMAP) 298 PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_mmap)); 299 #endif 300 } 301 302