Moving :mmap out of core binary into a module
[perl.git] / perlio.c
index a985dcc..592a094 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -451,10 +451,6 @@ PerlIO_findFILE(PerlIO *pio)
 
 #include "perliol.h"
 
-#ifdef HAS_MMAP
-#include <sys/mman.h>
-#endif
-
 void
 PerlIO_debug(const char *fmt, ...)
 {
@@ -1179,9 +1175,6 @@ PerlIO_default_layers(pTHX)
        PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_perlio));
        PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_stdio));
        PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_crlf));
-#ifdef HAS_MMAP
-       PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_mmap));
-#endif
        PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_utf8));
        PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_remove));
        PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_byte));
@@ -4826,297 +4819,6 @@ PERLIO_FUNCS_DECL(PerlIO_crlf) = {
     PerlIOCrlf_set_ptrcnt,
 };
 
-#ifdef HAS_MMAP
-/*--------------------------------------------------------------------------------------*/
-/*
- * mmap as "buffer" layer
- */
-
-typedef struct {
-    PerlIOBuf base;             /* PerlIOBuf stuff */
-    Mmap_t mptr;                /* Mapped address */
-    Size_t len;                 /* mapped length */
-    STDCHAR *bbuf;              /* malloced buffer if map fails */
-} PerlIOMmap;
-
-IV
-PerlIOMmap_map(pTHX_ PerlIO *f)
-{
-    dVAR;
-    PerlIOMmap * const m = PerlIOSelf(f, PerlIOMmap);
-    const IV flags = PerlIOBase(f)->flags;
-    IV code = 0;
-    if (m->len)
-       abort();
-    if (flags & PERLIO_F_CANREAD) {
-       PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf);
-       const int fd = PerlIO_fileno(f);
-       Stat_t st;
-       code = Fstat(fd, &st);
-       if (code == 0 && S_ISREG(st.st_mode)) {
-           SSize_t len = st.st_size - b->posn;
-           if (len > 0) {
-               Off_t posn;
-               if (PL_mmap_page_size <= 0)
-                 Perl_croak(aTHX_ "panic: bad pagesize %" IVdf,
-                            PL_mmap_page_size);
-               if (b->posn < 0) {
-                   /*
-                    * This is a hack - should never happen - open should
-                    * have set it !
-                    */
-                   b->posn = PerlIO_tell(PerlIONext(f));
-               }
-               posn = (b->posn / PL_mmap_page_size) * PL_mmap_page_size;
-               len = st.st_size - posn;
-               m->mptr = (Mmap_t)mmap(NULL, len, PROT_READ, MAP_SHARED, fd, posn);
-               if (m->mptr && m->mptr != (Mmap_t) - 1) {
-#if 0 && defined(HAS_MADVISE) && defined(MADV_SEQUENTIAL)
-                   madvise(m->mptr, len, MADV_SEQUENTIAL);
-#endif
-#if 0 && defined(HAS_MADVISE) && defined(MADV_WILLNEED)
-                   madvise(m->mptr, len, MADV_WILLNEED);
-#endif
-                   PerlIOBase(f)->flags =
-                       (flags & ~PERLIO_F_EOF) | PERLIO_F_RDBUF;
-                   b->end = ((STDCHAR *) m->mptr) + len;
-                   b->buf = ((STDCHAR *) m->mptr) + (b->posn - posn);
-                   b->ptr = b->buf;
-                   m->len = len;
-               }
-               else {
-                   b->buf = NULL;
-               }
-           }
-           else {
-               PerlIOBase(f)->flags =
-                   flags | PERLIO_F_EOF | PERLIO_F_RDBUF;
-               b->buf = NULL;
-               b->ptr = b->end = b->ptr;
-               code = -1;
-           }
-       }
-    }
-    return code;
-}
-
-IV
-PerlIOMmap_unmap(pTHX_ PerlIO *f)
-{
-    PerlIOMmap * const m = PerlIOSelf(f, PerlIOMmap);
-    IV code = 0;
-    if (m->len) {
-       PerlIOBuf * const b = &m->base;
-       if (b->buf) {
-           /* The munmap address argument is tricky: depending on the
-            * standard it is either "void *" or "caddr_t" (which is
-            * usually "char *" (signed or unsigned).  If we cast it
-            * to "void *", those that have it caddr_t and an uptight
-            * C++ compiler, will freak out.  But casting it as char*
-            * should work.  Maybe.  (Using Mmap_t figured out by
-            * Configure doesn't always work, apparently.) */
-           code = munmap((char*)m->mptr, m->len);
-           b->buf = NULL;
-           m->len = 0;
-           m->mptr = NULL;
-           if (PerlIO_seek(PerlIONext(f), b->posn, SEEK_SET) != 0)
-               code = -1;
-       }
-       b->ptr = b->end = b->buf;
-       PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF);
-    }
-    return code;
-}
-
-STDCHAR *
-PerlIOMmap_get_base(pTHX_ PerlIO *f)
-{
-    PerlIOMmap * const m = PerlIOSelf(f, PerlIOMmap);
-    PerlIOBuf * const b = &m->base;
-    if (b->buf && (PerlIOBase(f)->flags & PERLIO_F_RDBUF)) {
-       /*
-        * Already have a readbuffer in progress
-        */
-       return b->buf;
-    }
-    if (b->buf) {
-       /*
-        * We have a write buffer or flushed PerlIOBuf read buffer
-        */
-       m->bbuf = b->buf;       /* save it in case we need it again */
-       b->buf = NULL;          /* Clear to trigger below */
-    }
-    if (!b->buf) {
-       PerlIOMmap_map(aTHX_ f);        /* Try and map it */
-       if (!b->buf) {
-           /*
-            * Map did not work - recover PerlIOBuf buffer if we have one
-            */
-           b->buf = m->bbuf;
-       }
-    }
-    b->ptr = b->end = b->buf;
-    if (b->buf)
-       return b->buf;
-    return PerlIOBuf_get_base(aTHX_ f);
-}
-
-SSize_t
-PerlIOMmap_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
-{
-    PerlIOMmap * const m = PerlIOSelf(f, PerlIOMmap);
-    PerlIOBuf * const b = &m->base;
-    if (PerlIOBase(f)->flags & PERLIO_F_WRBUF)
-       PerlIO_flush(f);
-    if (b->ptr && (b->ptr - count) >= b->buf
-       && memEQ(b->ptr - count, vbuf, count)) {
-       b->ptr -= count;
-       PerlIOBase(f)->flags &= ~PERLIO_F_EOF;
-       return count;
-    }
-    if (m->len) {
-       /*
-        * Loose the unwritable mapped buffer
-        */
-       PerlIO_flush(f);
-       /*
-        * If flush took the "buffer" see if we have one from before
-        */
-       if (!b->buf && m->bbuf)
-           b->buf = m->bbuf;
-       if (!b->buf) {
-           PerlIOBuf_get_base(aTHX_ f);
-           m->bbuf = b->buf;
-       }
-    }
-    return PerlIOBuf_unread(aTHX_ f, vbuf, count);
-}
-
-SSize_t
-PerlIOMmap_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
-{
-    PerlIOMmap * const m = PerlIOSelf(f, PerlIOMmap);
-    PerlIOBuf * const b = &m->base;
-
-    if (!b->buf || !(PerlIOBase(f)->flags & PERLIO_F_WRBUF)) {
-       /*
-        * No, or wrong sort of, buffer
-        */
-       if (m->len) {
-           if (PerlIOMmap_unmap(aTHX_ f) != 0)
-               return 0;
-       }
-       /*
-        * If unmap took the "buffer" see if we have one from before
-        */
-       if (!b->buf && m->bbuf)
-           b->buf = m->bbuf;
-       if (!b->buf) {
-           PerlIOBuf_get_base(aTHX_ f);
-           m->bbuf = b->buf;
-       }
-    }
-    return PerlIOBuf_write(aTHX_ f, vbuf, count);
-}
-
-IV
-PerlIOMmap_flush(pTHX_ PerlIO *f)
-{
-    PerlIOMmap * const m = PerlIOSelf(f, PerlIOMmap);
-    PerlIOBuf * const b = &m->base;
-    IV code = PerlIOBuf_flush(aTHX_ f);
-    /*
-     * Now we are "synced" at PerlIOBuf level
-     */
-    if (b->buf) {
-       if (m->len) {
-           /*
-            * Unmap the buffer
-            */
-           if (PerlIOMmap_unmap(aTHX_ f) != 0)
-               code = -1;
-       }
-       else {
-           /*
-            * We seem to have a PerlIOBuf buffer which was not mapped
-            * remember it in case we need one later
-            */
-           m->bbuf = b->buf;
-       }
-    }
-    return code;
-}
-
-IV
-PerlIOMmap_fill(pTHX_ PerlIO *f)
-{
-    PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf);
-    IV code = PerlIO_flush(f);
-    if (code == 0 && !b->buf) {
-       code = PerlIOMmap_map(aTHX_ f);
-    }
-    if (code == 0 && !(PerlIOBase(f)->flags & PERLIO_F_RDBUF)) {
-       code = PerlIOBuf_fill(aTHX_ f);
-    }
-    return code;
-}
-
-IV
-PerlIOMmap_close(pTHX_ PerlIO *f)
-{
-    PerlIOMmap * const m = PerlIOSelf(f, PerlIOMmap);
-    PerlIOBuf * const b = &m->base;
-    IV code = PerlIO_flush(f);
-    if (m->bbuf) {
-       b->buf = m->bbuf;
-       m->bbuf = NULL;
-       b->ptr = b->end = b->buf;
-    }
-    if (PerlIOBuf_close(aTHX_ f) != 0)
-       code = -1;
-    return code;
-}
-
-PerlIO *
-PerlIOMmap_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
-{
- return PerlIOBase_dup(aTHX_ f, o, param, flags);
-}
-
-
-PERLIO_FUNCS_DECL(PerlIO_mmap) = {
-    sizeof(PerlIO_funcs),
-    "mmap",
-    sizeof(PerlIOMmap),
-    PERLIO_K_BUFFERED|PERLIO_K_RAW,
-    PerlIOBuf_pushed,
-    PerlIOBuf_popped,
-    PerlIOBuf_open,
-    PerlIOBase_binmode,         /* binmode */
-    NULL,
-    PerlIOBase_fileno,
-    PerlIOMmap_dup,
-    PerlIOBuf_read,
-    PerlIOMmap_unread,
-    PerlIOMmap_write,
-    PerlIOBuf_seek,
-    PerlIOBuf_tell,
-    PerlIOBuf_close,
-    PerlIOMmap_flush,
-    PerlIOMmap_fill,
-    PerlIOBase_eof,
-    PerlIOBase_error,
-    PerlIOBase_clearerr,
-    PerlIOBase_setlinebuf,
-    PerlIOMmap_get_base,
-    PerlIOBuf_bufsiz,
-    PerlIOBuf_get_ptr,
-    PerlIOBuf_get_cnt,
-    PerlIOBuf_set_ptrcnt,
-};
-
-#endif                          /* HAS_MMAP */
-
 PerlIO *
 Perl_PerlIO_stdin(pTHX)
 {