Moving :mmap out of core binary into a module
authorLeon Timmermans <fawaka@gmail.com>
Wed, 25 Jan 2012 19:38:46 +0000 (20:38 +0100)
committerFather Chrysostomos <sprout@cpan.org>
Mon, 30 Jan 2012 22:51:52 +0000 (14:51 -0800)
MANIFEST
Porting/Maintainers.pl
ext/PerlIO-mmap/mmap.pm [new file with mode: 0644]
ext/PerlIO-mmap/mmap.xs [new file with mode: 0644]
lib/.gitignore
lib/PerlIO.pm
perlio.c
perliol.h

index 5649557..f09f58e 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3787,6 +3787,8 @@ ext/PerlIO-encoding/MANIFEST      PerlIO::encoding list of files
 ext/PerlIO-encoding/t/encoding.t       See if PerlIO encoding conversion works
 ext/PerlIO-encoding/t/fallback.t       See if PerlIO fallbacks work
 ext/PerlIO-encoding/t/nolooping.t      Tests for PerlIO::encoding
+ext/PerlIO-mmap/mmap.pm        PerlIO layer for memory maps
+ext/PerlIO-mmap/mmap.xs        PerlIO layer for memory maps
 ext/PerlIO-scalar/scalar.pm    PerlIO layer for scalars
 ext/PerlIO-scalar/scalar.xs    PerlIO layer for scalars
 ext/PerlIO-scalar/t/scalar.t   See if PerlIO::scalar works
index ccb2db6..3f1f5c4 100755 (executable)
@@ -1407,6 +1407,12 @@ use File::Glob qw(:case);
         'UPSTREAM'   => 'blead',
     },
 
+    'PerlIO::mmap' => {
+        'MAINTAINER' => 'p5p',
+        'FILES'      => q[ext/PerlIO-mmap],
+        'UPSTREAM'   => 'blead',
+    },
+
     'PerlIO::scalar' => {
         'MAINTAINER' => 'p5p',
         'FILES'      => q[ext/PerlIO-scalar],
diff --git a/ext/PerlIO-mmap/mmap.pm b/ext/PerlIO-mmap/mmap.pm
new file mode 100644 (file)
index 0000000..7db4a55
--- /dev/null
@@ -0,0 +1,30 @@
+package PerlIO::mmap;
+use strict;
+use warnings;
+our $VERSION = '0.010';
+
+use XSLoader;
+XSLoader::load(__PACKAGE__, __PACKAGE__->VERSION);
+
+1;
+
+__END__
+
+=head1 NAME
+
+PerlIO::mmap - Memory mapped IO
+
+=head1 SYNOPSIS
+
+ open my $fh, '<:mmap', $filename;
+
+=head1 DESCRIPTION
+
+This layer does C<read> and C<write> operations by mmap()ing the file if possible, but falls back to the default behavior if not.
+
+=head1 IMPLEMENTATION NOTE
+
+C<PerlIO::mmap> only exists to use XSLoader to load C code that provides support for using memory mapped IO. One does not need to explicitly C<use PerlIO::mmap;>.
+
+=cut
+
diff --git a/ext/PerlIO-mmap/mmap.xs b/ext/PerlIO-mmap/mmap.xs
new file mode 100644 (file)
index 0000000..3e87d3b
--- /dev/null
@@ -0,0 +1,320 @@
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */
+
+#define PERL_NO_GET_CONTEXT
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#if defined(PERLIO_LAYERS) && defined(HAS_MMAP)
+
+#include "perliol.h"
+#include <sys/mman.h>
+
+/*
+ * 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 /* Layers available */
+
+MODULE = PerlIO::mmap  PACKAGE = PerlIO::mmap
+
+PROTOTYPES: DISABLE
+
+BOOT:
+{
+#if defined(PERLIO_LAYERS) && defined(HAS_MMAP)
+    PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_mmap));
+#endif
+}
+
index f74af56..6550dff 100644 (file)
 /Parse/CPAN/
 /Perl/OSType.pm
 /PerlIO/encoding.pm
+/PerlIO/mmap.pm
 /PerlIO/scalar.pm
 /PerlIO/via.pm
 /PerlIO/via/QuotedPrint.pm
index 46e6e44..c94685b 100644 (file)
@@ -93,20 +93,6 @@ as being an end-of-file marker.
 
 Based on the C<:perlio> layer.
 
-=item :mmap
-
-A layer which implements "reading" of files by using C<mmap()> to
-make a (whole) file appear in the process's address space, and then
-using that as PerlIO's "buffer". This I<may> be faster in certain
-circumstances for large files, and may result in less physical memory
-use when multiple processes are reading the same file.
-
-Files which are not C<mmap()>-able revert to behaving like the C<:perlio>
-layer. Writes also behave like the C<:perlio> layer, as C<mmap()> for write
-needs extra house-keeping (to extend the file) which negates any advantage.
-
-The C<:mmap> layer will not exist if the platform does not support C<mmap()>.
-
 =item :utf8
 
 Declares that the stream accepts perl's I<internal> encoding of
@@ -208,6 +194,20 @@ for example from Shift-JIS to Unicode.  Note that under C<stdio>
 an C<:encoding> also enables C<:utf8>.  See L<PerlIO::encoding>
 for more information.
 
+=item :mmap
+
+A layer which implements "reading" of files by using C<mmap()> to
+make a (whole) file appear in the process's address space, and then
+using that as PerlIO's "buffer". This I<may> be faster in certain
+circumstances for large files, and may result in less physical memory
+use when multiple processes are reading the same file.
+
+Files which are not C<mmap()>-able revert to behaving like the C<:perlio>
+layer. Writes also behave like the C<:perlio> layer, as C<mmap()> for write
+needs extra house-keeping (to extend the file) which negates any advantage.
+
+The C<:mmap> layer will not exist if the platform does not support C<mmap()>.
+
 =item :via
 
 Use C<:via(MODULE)> either in open() or binmode() to install a layer
@@ -284,7 +284,6 @@ DOS-like platforms and depending on the setting of C<$ENV{PERLIO}>:
  unset / "" unix perlio / stdio [1]     unix crlf
  stdio      unix perlio / stdio [1]     stdio
  perlio     unix perlio                 unix perlio
- mmap       unix mmap                   unix mmap
 
  # [1] "stdio" if Configure found out how to do "fast stdio" (depends
  # on the stdio implementation) and in Perl 5.8, otherwise "unix perlio"
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)
 {
index a51f99b..3bce866 100644 (file)
--- a/perliol.h
+++ b/perliol.h
@@ -113,9 +113,6 @@ EXTPERLIO PerlIO_funcs PerlIO_utf8;
 EXTPERLIO PerlIO_funcs PerlIO_byte;
 EXTPERLIO PerlIO_funcs PerlIO_raw;
 EXTPERLIO PerlIO_funcs PerlIO_pending;
-#ifdef HAS_MMAP
-EXTPERLIO PerlIO_funcs PerlIO_mmap;
-#endif
 #ifdef WIN32
 EXTPERLIO PerlIO_funcs PerlIO_win32;
 #endif
@@ -223,17 +220,6 @@ PERL_EXPORT_C SSize_t   PerlIOCrlf_unread(pTHX_ PerlIO *f, const void *vbuf, Siz
 PERL_EXPORT_C SSize_t   PerlIOCrlf_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count);
 PERL_EXPORT_C SSize_t   PerlIOCrlf_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count);
 
-/* Mmap */
-PERL_EXPORT_C IV        PerlIOMmap_close(pTHX_ PerlIO *f);
-PERL_EXPORT_C PerlIO *  PerlIOMmap_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags);
-PERL_EXPORT_C IV        PerlIOMmap_fill(pTHX_ PerlIO *f);
-PERL_EXPORT_C IV        PerlIOMmap_flush(pTHX_ PerlIO *f);
-PERL_EXPORT_C STDCHAR * PerlIOMmap_get_base(pTHX_ PerlIO *f);
-PERL_EXPORT_C IV        PerlIOMmap_map(pTHX_ PerlIO *f);
-PERL_EXPORT_C IV        PerlIOMmap_unmap(pTHX_ PerlIO *f);
-PERL_EXPORT_C SSize_t   PerlIOMmap_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count);
-PERL_EXPORT_C SSize_t   PerlIOMmap_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count);
-
 /* Pending */
 PERL_EXPORT_C IV        PerlIOPending_close(pTHX_ PerlIO *f);
 PERL_EXPORT_C IV        PerlIOPending_fill(pTHX_ PerlIO *f);