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