Moving :mmap out of core binary into a module

1 files changed, 0 insertions, 298 deletions

diff --git a/perlio.c b/perlio.c
index a985dcc0e8..592a09450b 100644
--- 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)
 {