/*
 * This file was generated automatically by ExtUtils::ParseXS version 3.40 from the
 * contents of mmap.xs. Do not edit this file, edit mmap.xs instead.
 *
 *    ANY CHANGES MADE HERE WILL BE LOST!
 *
 */

#line 1 "mmap.xs"
/*
 * ex: set ts=8 sts=4 sw=4 et:
 */

#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;

static 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);
	Stat_t st;
	const int fd = PerlIO_fileno(f);
        if (fd < 0) {
          SETERRNO(EBADF,RMS_IFI);
          return -1;
        }
	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;
}

static 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;
}

static 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);
}

static 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);
}

static 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);
}

static 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;
}

static 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;
}

static PerlIO *
PerlIOMmap_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
{
 return PerlIOBase_dup(aTHX_ f, o, param, flags);
}


static 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 */

#line 302 "mmap.c"
#ifndef PERL_UNUSED_VAR
#  define PERL_UNUSED_VAR(var) if (0) var = var
#endif

#ifndef dVAR
#  define dVAR		dNOOP
#endif


/* This stuff is not part of the API! You have been warned. */
#ifndef PERL_VERSION_DECIMAL
#  define PERL_VERSION_DECIMAL(r,v,s) (r*1000000 + v*1000 + s)
#endif
#ifndef PERL_DECIMAL_VERSION
#  define PERL_DECIMAL_VERSION \
	  PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)
#endif
#ifndef PERL_VERSION_GE
#  define PERL_VERSION_GE(r,v,s) \
	  (PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s))
#endif
#ifndef PERL_VERSION_LE
#  define PERL_VERSION_LE(r,v,s) \
	  (PERL_DECIMAL_VERSION <= PERL_VERSION_DECIMAL(r,v,s))
#endif

/* XS_INTERNAL is the explicit static-linkage variant of the default
 * XS macro.
 *
 * XS_EXTERNAL is the same as XS_INTERNAL except it does not include
 * "STATIC", ie. it exports XSUB symbols. You probably don't want that
 * for anything but the BOOT XSUB.
 *
 * See XSUB.h in core!
 */


/* TODO: This might be compatible further back than 5.10.0. */
#if PERL_VERSION_GE(5, 10, 0) && PERL_VERSION_LE(5, 15, 1)
#  undef XS_EXTERNAL
#  undef XS_INTERNAL
#  if defined(__CYGWIN__) && defined(USE_DYNAMIC_LOADING)
#    define XS_EXTERNAL(name) __declspec(dllexport) XSPROTO(name)
#    define XS_INTERNAL(name) STATIC XSPROTO(name)
#  endif
#  if defined(__SYMBIAN32__)
#    define XS_EXTERNAL(name) EXPORT_C XSPROTO(name)
#    define XS_INTERNAL(name) EXPORT_C STATIC XSPROTO(name)
#  endif
#  ifndef XS_EXTERNAL
#    if defined(HASATTRIBUTE_UNUSED) && !defined(__cplusplus)
#      define XS_EXTERNAL(name) void name(pTHX_ CV* cv __attribute__unused__)
#      define XS_INTERNAL(name) STATIC void name(pTHX_ CV* cv __attribute__unused__)
#    else
#      ifdef __cplusplus
#        define XS_EXTERNAL(name) extern "C" XSPROTO(name)
#        define XS_INTERNAL(name) static XSPROTO(name)
#      else
#        define XS_EXTERNAL(name) XSPROTO(name)
#        define XS_INTERNAL(name) STATIC XSPROTO(name)
#      endif
#    endif
#  endif
#endif

/* perl >= 5.10.0 && perl <= 5.15.1 */


/* The XS_EXTERNAL macro is used for functions that must not be static
 * like the boot XSUB of a module. If perl didn't have an XS_EXTERNAL
 * macro defined, the best we can do is assume XS is the same.
 * Dito for XS_INTERNAL.
 */
#ifndef XS_EXTERNAL
#  define XS_EXTERNAL(name) XS(name)
#endif
#ifndef XS_INTERNAL
#  define XS_INTERNAL(name) XS(name)
#endif

/* Now, finally, after all this mess, we want an ExtUtils::ParseXS
 * internal macro that we're free to redefine for varying linkage due
 * to the EXPORT_XSUB_SYMBOLS XS keyword. This is internal, use
 * XS_EXTERNAL(name) or XS_INTERNAL(name) in your code if you need to!
 */

#undef XS_EUPXS
#if defined(PERL_EUPXS_ALWAYS_EXPORT)
#  define XS_EUPXS(name) XS_EXTERNAL(name)
#else
   /* default to internal */
#  define XS_EUPXS(name) XS_INTERNAL(name)
#endif

#ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
#define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)

/* prototype to pass -Wmissing-prototypes */
STATIC void
S_croak_xs_usage(const CV *const cv, const char *const params);

STATIC void
S_croak_xs_usage(const CV *const cv, const char *const params)
{
    const GV *const gv = CvGV(cv);

    PERL_ARGS_ASSERT_CROAK_XS_USAGE;

    if (gv) {
        const char *const gvname = GvNAME(gv);
        const HV *const stash = GvSTASH(gv);
        const char *const hvname = stash ? HvNAME(stash) : NULL;

        if (hvname)
	    Perl_croak_nocontext("Usage: %s::%s(%s)", hvname, gvname, params);
        else
	    Perl_croak_nocontext("Usage: %s(%s)", gvname, params);
    } else {
        /* Pants. I don't think that it should be possible to get here. */
	Perl_croak_nocontext("Usage: CODE(0x%" UVxf ")(%s)", PTR2UV(cv), params);
    }
}
#undef  PERL_ARGS_ASSERT_CROAK_XS_USAGE

#define croak_xs_usage        S_croak_xs_usage

#endif

/* NOTE: the prototype of newXSproto() is different in versions of perls,
 * so we define a portable version of newXSproto()
 */
#ifdef newXS_flags
#define newXSproto_portable(name, c_impl, file, proto) newXS_flags(name, c_impl, file, proto, 0)
#else
#define newXSproto_portable(name, c_impl, file, proto) (PL_Sv=(SV*)newXS(name, c_impl, file), sv_setpv(PL_Sv, proto), (CV*)PL_Sv)
#endif /* !defined(newXS_flags) */

#if PERL_VERSION_LE(5, 21, 5)
#  define newXS_deffile(a,b) Perl_newXS(aTHX_ a,b,file)
#else
#  define newXS_deffile(a,b) Perl_newXS_deffile(aTHX_ a,b)
#endif

#line 446 "mmap.c"
#ifdef __cplusplus
extern "C"
#endif
XS_EXTERNAL(boot_PerlIO__mmap); /* prototype to pass -Wmissing-prototypes */
XS_EXTERNAL(boot_PerlIO__mmap)
{
#if PERL_VERSION_LE(5, 21, 5)
    dVAR; dXSARGS;
#else
    dVAR; dXSBOOTARGSXSAPIVERCHK;
#endif

    PERL_UNUSED_VAR(cv); /* -W */
    PERL_UNUSED_VAR(items); /* -W */
#if PERL_VERSION_LE(5, 21, 5)
    XS_VERSION_BOOTCHECK;
#  ifdef XS_APIVERSION_BOOTCHECK
    XS_APIVERSION_BOOTCHECK;
#  endif
#endif


    /* Initialisation Section */

#line 297 "mmap.xs"
{
#if defined(PERLIO_LAYERS) && defined(HAS_MMAP)
    PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_mmap));
#endif
}

#line 478 "mmap.c"

    /* End of Initialisation Section */

#if PERL_VERSION_LE(5, 21, 5)
#  if PERL_VERSION_GE(5, 9, 0)
    if (PL_unitcheckav)
        call_list(PL_scopestack_ix, PL_unitcheckav);
#  endif
    XSRETURN_YES;
#else
    Perl_xs_boot_epilog(aTHX_ ax);
#endif
}