List-MoreUtils-0.413HEADList-MoreUtils-0.413master

1 files changed, 1805 insertions, 0 deletions

diff --git a/MoreUtils.xs b/MoreUtils.xs
new file mode 100644
index 0000000..6e93971
--- /dev/null
+++ b/MoreUtils.xs
@@ -0,0 +1,1805 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "multicall.h"
+#include "ppport.h"
+
+#ifndef aTHX
+#  define aTHX
+#  define pTHX
+#endif
+
+#ifdef SVf_IVisUV
+#  define slu_sv_value(sv) (SvIOK(sv)) ? (SvIOK_UV(sv)) ? (NV)(SvUVX(sv)) : (NV)(SvIVX(sv)) : (SvNV(sv))
+#else
+#  define slu_sv_value(sv) (SvIOK(sv)) ? (NV)(SvIVX(sv)) : (SvNV(sv))
+#endif
+
+/*
+ * Perl < 5.18 had some kind of different SvIV_please_nomg
+ */
+#if PERL_VERSION < 18
+#undef SvIV_please_nomg
+#  define SvIV_please_nomg(sv) \
+	(!SvIOKp(sv) && (SvNOK(sv) || SvPOK(sv)) \
+	    ? (SvIV_nomg(sv), SvIOK(sv))	  \
+	    : SvIOK(sv))
+#endif
+
+/* compare left and right SVs. Returns:
+ * -1: <
+ *  0: ==
+ *  1: >
+ *  2: left or right was a NaN
+ */
+static I32
+ncmp(SV* left, SV * right)
+{
+    /* Fortunately it seems NaN isn't IOK */
+    if(SvAMAGIC(left) || SvAMAGIC(right))
+	return SvIVX(amagic_call(left, right, ncmp_amg, 0));
+
+    if (SvIV_please_nomg(right) && SvIV_please_nomg(left)) {
+	if (!SvUOK(left)) {
+	    const IV leftiv = SvIVX(left);
+	    if (!SvUOK(right)) {
+		/* ## IV <=> IV ## */
+		const IV rightiv = SvIVX(right);
+		return (leftiv > rightiv) - (leftiv < rightiv);
+	    }
+	    /* ## IV <=> UV ## */
+	    if (leftiv < 0)
+		/* As (b) is a UV, it's >=0, so it must be < */
+		return -1;
+	    {
+		const UV rightuv = SvUVX(right);
+		return ((UV)leftiv > rightuv) - ((UV)leftiv < rightuv);
+	    }
+	}
+
+	if (SvUOK(right)) {
+	    /* ## UV <=> UV ## */
+	    const UV leftuv = SvUVX(left);
+	    const UV rightuv = SvUVX(right);
+	    return (leftuv > rightuv) - (leftuv < rightuv);
+	}
+	/* ## UV <=> IV ## */
+	{
+	    const IV rightiv = SvIVX(right);
+	    if (rightiv < 0)
+		/* As (a) is a UV, it's >=0, so it cannot be < */
+		return 1;
+	    {
+		const UV leftuv = SvUVX(left);
+		return (leftuv > (UV)rightiv) - (leftuv < (UV)rightiv);
+	    }
+	}
+	assert(0); /* NOTREACHED */
+    }
+    else
+    {
+#ifdef SvNV_nomg
+        NV const rnv = SvNV_nomg(right);
+        NV const lnv = SvNV_nomg(left);
+#else
+        NV const rnv = slu_sv_value(right);
+        NV const lnv = slu_sv_value(left);
+#endif
+
+#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
+        if (Perl_isnan(lnv) || Perl_isnan(rnv)) {
+	    return 2;
+        }
+        return (lnv > rnv) - (lnv < rnv);
+#else
+        if (lnv < rnv)
+	    return -1;
+        if (lnv > rnv)
+	    return 1;
+        if (lnv == rnv)
+            return 0;
+        return 2;
+#endif
+    }
+}
+
+#define FUNC_NAME GvNAME(GvEGV(ST(items)))
+
+/* shameless stolen from PadWalker */
+#ifndef PadARRAY
+typedef AV PADNAMELIST;
+typedef SV PADNAME;
+# if PERL_VERSION < 8 || (PERL_VERSION == 8 && !PERL_SUBVERSION)
+typedef AV PADLIST;
+typedef AV PAD;
+# endif
+# define PadlistARRAY(pl)       ((PAD **)AvARRAY(pl))
+# define PadlistMAX(pl)         AvFILLp(pl)
+# define PadlistNAMES(pl)       (*PadlistARRAY(pl))
+# define PadnamelistARRAY(pnl)  ((PADNAME **)AvARRAY(pnl))
+# define PadnamelistMAX(pnl)    AvFILLp(pnl)
+# define PadARRAY               AvARRAY
+# define PadnameIsOUR(pn)       !!(SvFLAGS(pn) & SVpad_OUR)
+# define PadnameOURSTASH(pn)    SvOURSTASH(pn)
+# define PadnameOUTER(pn)       !!SvFAKE(pn)
+# define PadnamePV(pn)          (SvPOKp(pn) ? SvPVX(pn) : NULL)
+#endif
+#ifndef PadnameSV
+# define PadnameSV(pn)          pn
+#endif
+#ifndef PadnameFLAGS
+# define PadnameFLAGS(pn)       (SvFLAGS(PadnameSV(pn)))
+#endif
+
+static int 
+in_pad (SV *code)
+{
+    GV *gv;
+    HV *stash;
+    CV *cv = sv_2cv(code, &stash, &gv, 0);
+    PADLIST *pad_list = (CvPADLIST(cv));
+    PADNAMELIST *pad_namelist = PadlistNAMES(pad_list);
+    PADNAME **pad_names = PadnamelistARRAY(pad_namelist);
+    int i;
+
+    for (i=PadnamelistMAX(pad_namelist); i>=0; --i) {
+	PADNAME* name_sv = PadnamelistARRAY(pad_namelist)[i];
+	if (name_sv) {
+	    char *name_str = PadnamePV(name_sv);
+	    if (name_str) {
+
+		/* perl < 5.6.0 does not yet have our */
+#               ifdef SVpad_OUR
+		if(PadnameIsOUR(name_sv))
+		    continue;
+#               endif
+
+		if (!(PadnameFLAGS(name_sv)) & SVf_OK)
+		    continue;
+
+		if (strEQ(name_str, "$a") || strEQ(name_str, "$b"))
+		    return 1;
+	    }
+	}
+    }
+    return 0;
+}
+
+#define WARN_OFF \
+    SV *oldwarn = PL_curcop->cop_warnings; \
+    PL_curcop->cop_warnings = pWARN_NONE;
+
+#define WARN_ON \
+    PL_curcop->cop_warnings = oldwarn;
+
+#define EACH_ARRAY_BODY \
+	int i;										\
+	arrayeach_args * args;								\
+	HV *stash = gv_stashpv("List::MoreUtils_ea", TRUE);				\
+	CV *closure = newXS(NULL, XS_List__MoreUtils__array_iterator, __FILE__);	\
+											\
+	/* prototype */									\
+	sv_setpv((SV*)closure, ";$");							\
+											\
+	New(0, args, 1, arrayeach_args);						\
+	New(0, args->avs, items, AV*);							\
+	args->navs = items;								\
+	args->curidx = 0;								\
+											\
+	for (i = 0; i < items; i++) {							\
+	    if(!arraylike(ST(i)))							\
+	       croak_xs_usage(cv,  "\\@;\\@\\@...");					\
+	    args->avs[i] = (AV*)SvRV(ST(i));						\
+	    SvREFCNT_inc(args->avs[i]);							\
+	}										\
+											\
+	CvXSUBANY(closure).any_ptr = args;						\
+	RETVAL = newRV_noinc((SV*)closure);						\
+											\
+	/* in order to allow proper cleanup in DESTROY-handler */			\
+	sv_bless(RETVAL, stash)
+
+
+#define FOR_EACH(on_item)			\
+    if(!codelike(code))				\
+       croak_xs_usage(cv,  "code, ...");	\
+						\
+    if (items > 1) {				\
+        dMULTICALL;				\
+        int i;					\
+        HV *stash;				\
+        GV *gv;					\
+        CV *_cv;				\
+        SV **args = &PL_stack_base[ax];		\
+        I32 gimme = G_SCALAR;			\
+        _cv = sv_2cv(code, &stash, &gv, 0);	\
+        PUSH_MULTICALL(_cv);			\
+        SAVESPTR(GvSV(PL_defgv));		\
+						\
+        for(i = 1 ; i < items ; ++i) {		\
+            GvSV(PL_defgv) = args[i];		\
+            MULTICALL;				\
+	    on_item;				\
+        }					\
+        POP_MULTICALL;				\
+    }
+
+#define TRUE_JUNCTION	\
+    FOR_EACH(if (SvTRUE(*PL_stack_sp)) ON_TRUE) \
+    else ON_EMPTY;
+
+#define FALSE_JUNCTION	\
+    FOR_EACH(if (!SvTRUE(*PL_stack_sp)) ON_FALSE) \
+    else ON_EMPTY;
+
+/* #include "dhash.h" */
+
+/* need this one for array_each() */
+typedef struct {
+    AV **avs;	    /* arrays over which to iterate in parallel */
+    int navs;	    /* number of arrays */
+    int curidx;	    /* the current index of the iterator */
+} arrayeach_args;
+
+/* used for natatime */
+typedef struct {
+    SV **svs;
+    int nsvs;
+    int curidx;
+    int natatime;
+} natatime_args;
+
+void
+insert_after (int idx, SV *what, AV *av) {
+    int i, len;
+    av_extend(av, (len = av_len(av) + 1));
+
+    for (i = len; i > idx+1; i--) {
+	SV **sv = av_fetch(av, i-1, FALSE);
+	SvREFCNT_inc(*sv);
+	av_store(av, i, *sv);
+    }
+    if (!av_store(av, idx+1, what))
+	SvREFCNT_dec(what);
+}
+
+static int
+is_like(SV *sv, const char *like)
+{
+    int likely = 0;
+    if( sv_isobject( sv ) )
+    {
+        dSP;
+        int count;
+
+        ENTER;
+        SAVETMPS;
+        PUSHMARK(SP);
+        XPUSHs( sv_2mortal( newSVsv( sv ) ) );
+        XPUSHs( sv_2mortal( newSVpv( like, strlen(like) ) ) );
+        PUTBACK;
+
+        if( ( count = call_pv("overload::Method", G_SCALAR) ) )
+        {
+            I32 ax;
+            SPAGAIN;
+
+            SP -= count;
+            ax = (SP - PL_stack_base) + 1;
+            if( SvTRUE(ST(0)) )
+                ++likely;
+        }
+
+        PUTBACK;
+        FREETMPS;
+        LEAVE;
+    }
+
+    return likely;
+}
+
+static int
+is_array(SV *sv)
+{
+    return SvROK(sv) && ( SVt_PVAV == SvTYPE(SvRV(sv) ) );
+}
+
+static int
+codelike(SV *code)
+{
+    SvGETMAGIC(code);
+    return SvROK(code) && ( ( SVt_PVCV == SvTYPE(SvRV(code)) ) || ( is_like(code, "&{}" ) ) );
+}
+
+static int
+arraylike(SV *array)
+{
+    SvGETMAGIC(array);
+    return is_array(array) || is_like( array, "@{}" );
+}
+
+MODULE = List::MoreUtils_ea             PACKAGE = List::MoreUtils_ea
+
+void
+DESTROY(sv)
+    SV *sv;
+    CODE:
+    {
+	int i;
+	CV *code = (CV*)SvRV(sv);
+	arrayeach_args *args = (arrayeach_args *)(CvXSUBANY(code).any_ptr);
+	if (args) {
+	    for (i = 0; i < args->navs; ++i)
+		SvREFCNT_dec(args->avs[i]);
+	    Safefree(args->avs);
+	    Safefree(args);
+	    CvXSUBANY(code).any_ptr = NULL;
+	}
+    }
+
+
+MODULE = List::MoreUtils_na             PACKAGE = List::MoreUtils_na
+
+void
+DESTROY(sv)
+    SV *sv;
+    CODE:
+    {
+	int i;
+	CV *code = (CV*)SvRV(sv);
+	natatime_args *args = (natatime_args *)(CvXSUBANY(code).any_ptr);
+	if (args) {
+	    for (i = 0; i < args->nsvs; ++i)
+		SvREFCNT_dec(args->svs[i]);
+	    Safefree(args->svs);
+	    Safefree(args);
+	    CvXSUBANY(code).any_ptr = NULL;
+	}
+    }
+
+MODULE = List::MoreUtils		PACKAGE = List::MoreUtils
+
+void
+any (code,...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+#define ON_TRUE { POP_MULTICALL; XSRETURN_YES; }
+#define ON_EMPTY XSRETURN_NO
+    TRUE_JUNCTION;
+    XSRETURN_NO;
+#undef ON_EMPTY
+#undef ON_TRUE
+}
+
+void
+all (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+#define ON_FALSE { POP_MULTICALL; XSRETURN_NO; }
+#define ON_EMPTY XSRETURN_YES
+    FALSE_JUNCTION;
+    XSRETURN_YES;
+#undef ON_EMPTY
+#undef ON_FALSE
+}
+
+
+void
+none (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+#define ON_TRUE { POP_MULTICALL; XSRETURN_NO; }
+#define ON_EMPTY XSRETURN_YES
+    TRUE_JUNCTION;
+    XSRETURN_YES;
+#undef ON_EMPTY
+#undef ON_TRUE
+}
+
+void
+notall (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+#define ON_FALSE { POP_MULTICALL; XSRETURN_YES; }
+#define ON_EMPTY XSRETURN_NO
+    FALSE_JUNCTION;
+    XSRETURN_NO;
+#undef ON_EMPTY
+#undef ON_FALSE
+}
+
+void
+one (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+    int found = 0;
+#define ON_TRUE { if (found++) { POP_MULTICALL; XSRETURN_NO; }; }
+#define ON_EMPTY XSRETURN_YES
+    TRUE_JUNCTION;
+    if (found)
+        XSRETURN_YES;
+    XSRETURN_NO;
+#undef ON_EMPTY
+#undef ON_TRUE
+}
+
+void
+any_u (code,...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+#define ON_TRUE { POP_MULTICALL; XSRETURN_YES; }
+#define ON_EMPTY XSRETURN_UNDEF
+    TRUE_JUNCTION;
+    XSRETURN_NO;
+#undef ON_EMPTY
+#undef ON_TRUE
+}
+
+void
+all_u (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+#define ON_FALSE { POP_MULTICALL; XSRETURN_NO; }
+#define ON_EMPTY XSRETURN_UNDEF
+    FALSE_JUNCTION;
+    XSRETURN_YES;
+#undef ON_EMPTY
+#undef ON_FALSE
+}
+
+
+void
+none_u (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+#define ON_TRUE { POP_MULTICALL; XSRETURN_NO; }
+#define ON_EMPTY XSRETURN_UNDEF
+    TRUE_JUNCTION;
+    XSRETURN_YES;
+#undef ON_EMPTY
+#undef ON_TRUE
+}
+
+void
+notall_u (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+#define ON_FALSE { POP_MULTICALL; XSRETURN_YES; }
+#define ON_EMPTY XSRETURN_UNDEF
+    FALSE_JUNCTION;
+    XSRETURN_NO;
+#undef ON_EMPTY
+#undef ON_FALSE
+}
+
+void
+one_u (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+    int found = 0;
+#define ON_TRUE { if (found++) { POP_MULTICALL; XSRETURN_NO; }; }
+#define ON_EMPTY XSRETURN_UNDEF
+    TRUE_JUNCTION;
+    if (found)
+        XSRETURN_YES;
+    XSRETURN_NO;
+#undef ON_EMPTY
+#undef ON_TRUE
+}
+
+int
+true (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+    I32 count = 0;
+    FOR_EACH(if (SvTRUE(*PL_stack_sp)) count++);
+    RETVAL = count;
+}
+OUTPUT:
+    RETVAL
+
+int
+false (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+    I32 count = 0;
+    FOR_EACH(if (!SvTRUE(*PL_stack_sp)) count++);
+    RETVAL = count;
+}
+OUTPUT:
+    RETVAL
+
+int
+firstidx (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+    RETVAL = -1;
+    FOR_EACH(if (SvTRUE(*PL_stack_sp)) { RETVAL = i-1; break; });
+}
+OUTPUT:
+    RETVAL
+
+SV *
+firstval (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+    RETVAL = &PL_sv_undef;
+    FOR_EACH(if (SvTRUE(*PL_stack_sp)) { SvREFCNT_inc(RETVAL = args[i]); break; });
+}
+OUTPUT:
+    RETVAL
+
+SV *
+firstres (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+    RETVAL = &PL_sv_undef;
+    FOR_EACH(if (SvTRUE(*PL_stack_sp)) { SvREFCNT_inc(RETVAL = *PL_stack_sp); break; });
+}
+OUTPUT:
+    RETVAL
+
+int
+onlyidx (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+    int found = 0;
+    RETVAL = -1;
+    FOR_EACH(if (SvTRUE(*PL_stack_sp)) { if (found++) {RETVAL = -1; break;} RETVAL = i-1; });
+}
+OUTPUT:
+    RETVAL
+
+SV *
+onlyval (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+    int found = 0;
+    RETVAL = &PL_sv_undef;
+    FOR_EACH(if (SvTRUE(*PL_stack_sp)) { if (found++) {SvREFCNT_dec(RETVAL); RETVAL = &PL_sv_undef; break;} SvREFCNT_inc(RETVAL = args[i]); });
+}
+OUTPUT:
+    RETVAL
+
+SV *
+onlyres (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+    int found = 0;
+    RETVAL = &PL_sv_undef;
+    FOR_EACH(if (SvTRUE(*PL_stack_sp)) { if (found++) {SvREFCNT_dec(RETVAL); RETVAL = &PL_sv_undef; break;}SvREFCNT_inc(RETVAL = *PL_stack_sp); });
+}
+OUTPUT:
+    RETVAL
+
+int
+lastidx (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+    dMULTICALL;
+    int i;
+    HV *stash;
+    GV *gv;
+    I32 gimme = G_SCALAR;
+    SV **args = &PL_stack_base[ax];
+    CV *_cv;
+
+    if(!codelike(code))
+       croak_xs_usage(cv,  "code, ...");
+
+    RETVAL = -1;
+
+    if (items > 1) {
+	_cv = sv_2cv(code, &stash, &gv, 0);
+	PUSH_MULTICALL(_cv);
+	SAVESPTR(GvSV(PL_defgv));
+
+	for (i = items-1 ; i > 0 ; --i) {
+	    GvSV(PL_defgv) = args[i];
+	    MULTICALL;
+	    if (SvTRUE(*PL_stack_sp)) {
+		RETVAL = i-1;
+		break;
+	    }
+	}
+	POP_MULTICALL;
+    }
+}
+OUTPUT:
+    RETVAL
+
+SV *
+lastval (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+    dMULTICALL;
+    int i;
+    HV *stash;
+    GV *gv;
+    I32 gimme = G_SCALAR;
+    SV **args = &PL_stack_base[ax];
+    CV *_cv;
+
+    RETVAL = &PL_sv_undef;
+
+    if(!codelike(code))
+       croak_xs_usage(cv,  "code, ...");
+
+    if (items > 1) {
+	_cv = sv_2cv(code, &stash, &gv, 0);
+	PUSH_MULTICALL(_cv);
+	SAVESPTR(GvSV(PL_defgv));
+
+	for (i = items-1 ; i > 0 ; --i) {
+	    GvSV(PL_defgv) = args[i];
+	    MULTICALL;
+	    if (SvTRUE(*PL_stack_sp)) {
+		/* see comment in indexes() */
+		SvREFCNT_inc(RETVAL = args[i]);
+		break;
+	    }
+	}
+	POP_MULTICALL;
+    }
+}
+OUTPUT:
+    RETVAL
+
+SV *
+lastres (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+    dMULTICALL;
+    int i;
+    HV *stash;
+    GV *gv;
+    I32 gimme = G_SCALAR;
+    SV **args = &PL_stack_base[ax];
+    CV *_cv;
+
+    RETVAL = &PL_sv_undef;
+
+    if(!codelike(code))
+       croak_xs_usage(cv,  "code, ...");
+
+    if (items > 1) {
+	_cv = sv_2cv(code, &stash, &gv, 0);
+	PUSH_MULTICALL(_cv);
+	SAVESPTR(GvSV(PL_defgv));
+
+	for (i = items-1 ; i > 0 ; --i) {
+	    GvSV(PL_defgv) = args[i];
+	    MULTICALL;
+	    if (SvTRUE(*PL_stack_sp)) {
+		/* see comment in indexes() */
+		SvREFCNT_inc(RETVAL = *PL_stack_sp);
+		break;
+	    }
+	}
+	POP_MULTICALL;
+    }
+}
+OUTPUT:
+    RETVAL
+
+int
+insert_after (code, val, avref)
+    SV *code;
+    SV *val;
+    SV *avref;
+PROTOTYPE: &$\@
+CODE:
+{
+    dMULTICALL;
+    int i;
+    int len;
+    HV *stash;
+    GV *gv;
+    I32 gimme = G_SCALAR;
+    CV *_cv;
+    AV *av;
+
+    if(!codelike(code))
+       croak_xs_usage(cv,  "code, val, \\@area_of_operation");
+    if(!arraylike(avref))
+       croak_xs_usage(cv,  "code, val, \\@area_of_operation");
+
+    av = (AV*)SvRV(avref);
+    len = av_len(av);
+    RETVAL = 0;
+
+    _cv = sv_2cv(code, &stash, &gv, 0);
+    PUSH_MULTICALL(_cv);
+    SAVESPTR(GvSV(PL_defgv));
+
+    for (i = 0; i <= len ; ++i) {
+	GvSV(PL_defgv) = *av_fetch(av, i, FALSE);
+	MULTICALL;
+	if (SvTRUE(*PL_stack_sp)) {
+	    RETVAL = 1;
+	    break;
+	}
+    }
+
+    POP_MULTICALL;
+
+    if (RETVAL) {
+	SvREFCNT_inc(val);
+	insert_after(i, val, av);
+    }
+}
+OUTPUT:
+    RETVAL
+
+int
+insert_after_string (string, val, avref)
+	SV *string;
+	SV *val;
+	SV *avref;
+    PROTOTYPE: $$\@
+    CODE:
+    {
+	int i;
+	AV *av;
+	int len;
+	SV **sv;
+	STRLEN slen = 0, alen;
+	char *str;
+	char *astr;
+	RETVAL = 0;
+
+	if(!arraylike(avref))
+	   croak_xs_usage(cv,  "string, val, \\@area_of_operation");
+
+	av = (AV*)SvRV(avref);
+	len = av_len(av);
+
+	if (SvTRUE(string))
+	    str = SvPV(string, slen);
+	else
+	    str = NULL;
+
+	for (i = 0; i <= len ; i++) {
+	    sv = av_fetch(av, i, FALSE);
+	    if (SvTRUE(*sv))
+		astr = SvPV(*sv, alen);
+	    else {
+		astr = NULL;
+		alen = 0;
+	    }
+	    if (slen == alen && memcmp(astr, str, slen) == 0) {
+		RETVAL = 1;
+		break;
+	    }
+	}
+	if (RETVAL) {
+	    SvREFCNT_inc(val);
+	    insert_after(i, val, av);
+	}
+
+    }
+    OUTPUT:
+	RETVAL
+
+void
+apply (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+    dMULTICALL;
+    int i;
+    HV *stash;
+    GV *gv;
+    I32 gimme = G_SCALAR;
+    CV *_cv;
+    SV **args = &PL_stack_base[ax];
+
+    if(!codelike(code))
+       croak_xs_usage(cv,  "code, ...");
+
+    if (items <= 1)
+	XSRETURN_EMPTY;
+
+    _cv = sv_2cv(code, &stash, &gv, 0);
+    PUSH_MULTICALL(_cv);
+    SAVESPTR(GvSV(PL_defgv));
+
+    for(i = 1 ; i < items ; ++i) {
+	GvSV(PL_defgv) = newSVsv(args[i]);
+	MULTICALL;
+	args[i-1] = GvSV(PL_defgv);
+    }
+    POP_MULTICALL;
+
+    for(i = 1 ; i < items ; ++i)
+        sv_2mortal(args[i-1]);
+
+    XSRETURN(items-1);
+}
+
+void
+after (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+    dMULTICALL;
+    int i, j;
+    HV *stash;
+    CV *_cv;
+    GV *gv;
+    I32 gimme = G_SCALAR;
+    SV **args = &PL_stack_base[ax];
+
+    if(!codelike(code))
+       croak_xs_usage(cv,  "code, ...");
+
+    if (items <= 1)
+	XSRETURN_EMPTY;
+
+    _cv = sv_2cv(code, &stash, &gv, 0);
+    PUSH_MULTICALL(_cv);
+    SAVESPTR(GvSV(PL_defgv));
+
+    for (i = 1; i < items; i++) {
+	GvSV(PL_defgv) = args[i];
+	MULTICALL;
+	if (SvTRUE(*PL_stack_sp)) {
+	    break;
+	}
+    }
+
+    POP_MULTICALL;
+
+    for (j = i + 1; j < items; ++j)
+	args[j-i-1] = args[j];
+
+    XSRETURN(items-i-1);
+}
+
+void
+after_incl (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+    dMULTICALL;
+    int i, j;
+    HV *stash;
+    CV *_cv;
+    GV *gv;
+    I32 gimme = G_SCALAR;
+    SV **args = &PL_stack_base[ax];
+
+    if(!codelike(code))
+       croak_xs_usage(cv,  "code, ...");
+
+    if (items <= 1)
+	XSRETURN_EMPTY;
+
+    _cv = sv_2cv(code, &stash, &gv, 0);
+    PUSH_MULTICALL(_cv);
+    SAVESPTR(GvSV(PL_defgv));
+
+    for (i = 1; i < items; i++) {
+	GvSV(PL_defgv) = args[i];
+	MULTICALL;
+	if (SvTRUE(*PL_stack_sp)) {
+	    break;
+	}
+    }
+
+    POP_MULTICALL;
+
+    for (j = i; j < items; j++)
+	args[j-i] = args[j];
+
+    XSRETURN(items-i);
+}
+
+void
+before (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+    dMULTICALL;
+    int i;
+    HV *stash;
+    GV *gv;
+    I32 gimme = G_SCALAR;
+    SV **args = &PL_stack_base[ax];
+    CV *_cv;
+
+    if(!codelike(code))
+       croak_xs_usage(cv,  "code, ...");
+
+    if (items <= 1)
+	XSRETURN_EMPTY;
+
+    _cv = sv_2cv(code, &stash, &gv, 0);
+    PUSH_MULTICALL(_cv);
+    SAVESPTR(GvSV(PL_defgv));
+
+    for (i = 1; i < items; i++) {
+	GvSV(PL_defgv) = args[i];
+	MULTICALL;
+	if (SvTRUE(*PL_stack_sp)) {
+	    break;
+	}
+	args[i-1] = args[i];
+    }
+
+    POP_MULTICALL;
+
+    XSRETURN(i-1);
+}
+
+void
+before_incl (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+    dMULTICALL;
+    int i;
+    HV *stash;
+    GV *gv;
+    I32 gimme = G_SCALAR;
+    SV **args = &PL_stack_base[ax];
+    CV *_cv;
+
+    if(!codelike(code))
+       croak_xs_usage(cv,  "code, ...");
+
+    if (items <= 1)
+	XSRETURN_EMPTY;
+
+    _cv = sv_2cv(code, &stash, &gv, 0);
+    PUSH_MULTICALL(_cv);
+    SAVESPTR(GvSV(PL_defgv));
+
+    for (i = 1; i < items; ++i) {
+	GvSV(PL_defgv) = args[i];
+	MULTICALL;
+	args[i-1] = args[i];
+	if (SvTRUE(*PL_stack_sp)) {
+	    ++i;
+	    break;
+	}
+    }
+
+    POP_MULTICALL;
+
+    XSRETURN(i-1);
+}
+
+void
+indexes (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+    dMULTICALL;
+    int i, j;
+    HV *stash;
+    GV *gv;
+    I32 gimme = G_SCALAR;
+    SV **args = &PL_stack_base[ax];
+    CV *_cv;
+
+    if(!codelike(code))
+       croak_xs_usage(cv,  "code, ...");
+
+    if (items <= 1)
+	XSRETURN_EMPTY;
+
+    _cv = sv_2cv(code, &stash, &gv, 0);
+    PUSH_MULTICALL(_cv);
+    SAVESPTR(GvSV(PL_defgv));
+
+    for (i = 1, j = 0; i < items; i++) {
+	GvSV(PL_defgv) = args[i];
+	MULTICALL;
+	if (SvTRUE(*PL_stack_sp))
+            /* POP_MULTICALL can free mortal temporaries, so we defer
+             * mortalising the returned values till after that's been
+             * done */
+	    args[j++] = newSViv(i-1);
+    }
+
+    POP_MULTICALL;
+
+    for (i = 0; i < j; i++)
+        sv_2mortal(args[i]);
+
+    XSRETURN(j);
+}
+
+void
+_array_iterator (method = "")
+    const char *method;
+    PROTOTYPE: ;$
+    CODE:
+    {
+	int i;
+	int exhausted = 1;
+
+	/* 'cv' is the hidden argument with which XS_List__MoreUtils__array_iterator (this XSUB)
+	 * is called. The closure_arg struct is stored in this CV. */
+
+	arrayeach_args *args = (arrayeach_args *)(CvXSUBANY(cv).any_ptr);
+
+	if (strEQ(method, "index")) {
+	    EXTEND(SP, 1);
+	    ST(0) = args->curidx > 0 ? sv_2mortal(newSViv(args->curidx-1)) : &PL_sv_undef;
+	    XSRETURN(1);
+	}
+
+	EXTEND(SP, args->navs);
+
+	for (i = 0; i < args->navs; i++) {
+	    AV *av = args->avs[i];
+	    if (args->curidx <= av_len(av)) {
+		ST(i) = sv_2mortal(newSVsv(*av_fetch(av, args->curidx, FALSE)));
+		exhausted = 0;
+		continue;
+	    }
+	    ST(i) = &PL_sv_undef;
+	}
+
+	if (exhausted)
+	    XSRETURN_EMPTY;
+
+	args->curidx++;
+	XSRETURN(args->navs);
+    }
+
+SV *
+each_array (...)
+    PROTOTYPE: \@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@
+    CODE:
+    {
+	EACH_ARRAY_BODY;
+    }
+    OUTPUT:
+	RETVAL
+
+SV *
+each_arrayref (...)
+    CODE:
+    {
+	EACH_ARRAY_BODY;
+    }
+    OUTPUT:
+	RETVAL
+
+#if 0
+void
+_pairwise (code, ...)
+	SV *code;
+    PROTOTYPE: &\@\@
+    PPCODE:
+    {
+#define av_items(a) (av_len(a)+1)
+
+	int i;
+	AV *avs[2];
+	SV **oldsp;
+
+	int nitems = 0, maxitems = 0;
+
+	if(!codelike(code))
+	   croak_xs_usage(cv,  "code, ...");
+
+	/* deref AV's for convenience and
+	 * get maximum items */
+	avs[0] = (AV*)SvRV(ST(1));
+	avs[1] = (AV*)SvRV(ST(2));
+	maxitems = av_items(avs[0]);
+	if (av_items(avs[1]) > maxitems)
+	    maxitems = av_items(avs[1]);
+
+	if (!PL_firstgv || !PL_secondgv) {
+	    SAVESPTR(PL_firstgv);
+	    SAVESPTR(PL_secondgv);
+	    PL_firstgv = gv_fetchpv("a", TRUE, SVt_PV);
+	    PL_secondgv = gv_fetchpv("b", TRUE, SVt_PV);
+	}
+
+	oldsp = PL_stack_base;
+	EXTEND(SP, maxitems);
+	ENTER;
+	for (i = 0; i < maxitems; i++) {
+	    int nret;
+	    SV **svp = av_fetch(avs[0], i, FALSE);
+	    GvSV(PL_firstgv) = svp ? *svp : &PL_sv_undef;
+	    svp = av_fetch(avs[1], i, FALSE);
+	    GvSV(PL_secondgv) = svp ? *svp : &PL_sv_undef;
+	    PUSHMARK(SP);
+	    PUTBACK;
+	    nret = call_sv(code, G_EVAL|G_ARRAY);
+            if (SvTRUE(ERRSV))
+                croak("%s", SvPV_nolen(ERRSV));
+	    SPAGAIN;
+	    nitems += nret;
+	    while (nret--) {
+		SvREFCNT_inc(*PL_stack_sp++);
+	    }
+	}
+	PL_stack_base = oldsp;
+	LEAVE;
+	XSRETURN(nitems);
+    }
+
+#endif
+
+void
+pairwise (code, ...)
+	SV *code;
+    PROTOTYPE: &\@\@
+    PPCODE:
+    {
+#define av_items(a) (av_len(a)+1)
+
+	/* This function is not quite as efficient as it ought to be: We call
+	 * 'code' multiple times and want to gather its return values all in
+	 * one list. However, each call resets the stack pointer so there is no
+	 * obvious way to get the return values onto the stack without making
+	 * intermediate copies of the pointers.  The above disabled solution
+	 * would be more efficient. Unfortunately it doesn't work (and, as of
+	 * now, wouldn't deal with 'code' returning more than one value).
+	 *
+	 * The current solution is a fair trade-off. It only allocates memory
+	 * for a list of SV-pointers, as many as there are return values. It
+	 * temporarily stores 'code's return values in this list and, when
+	 * done, copies them down to SP. */
+
+	int i, j;
+	AV *avs[2];
+	SV **buf, **p;	/* gather return values here and later copy down to SP */
+	int alloc;
+
+	int nitems = 0, maxitems = 0;
+	int d;
+
+	if(!codelike(code))
+	   croak_xs_usage(cv,  "code, list, list");
+	if(!arraylike(ST(1)))
+	   croak_xs_usage(cv,  "code, list, list");
+	if(!arraylike(ST(2)))
+	   croak_xs_usage(cv,  "code, list, list");
+
+	if (in_pad(code)) {
+	    croak("Can't use lexical $a or $b in pairwise code block");
+	}
+
+	/* deref AV's for convenience and
+	 * get maximum items */
+	avs[0] = (AV*)SvRV(ST(1));
+	avs[1] = (AV*)SvRV(ST(2));
+	maxitems = av_items(avs[0]);
+	if (av_items(avs[1]) > maxitems)
+	    maxitems = av_items(avs[1]);
+
+	if (!PL_firstgv || !PL_secondgv) {
+	    SAVESPTR(PL_firstgv);
+	    SAVESPTR(PL_secondgv);
+	    PL_firstgv = gv_fetchpv("a", TRUE, SVt_PV);
+	    PL_secondgv = gv_fetchpv("b", TRUE, SVt_PV);
+	}
+
+	New(0, buf, alloc = maxitems, SV*);
+
+	ENTER;
+	for (d = 0, i = 0; i < maxitems; i++) {
+	    int nret;
+	    SV **svp = av_fetch(avs[0], i, FALSE);
+	    GvSV(PL_firstgv) = svp ? *svp : &PL_sv_undef;
+	    svp = av_fetch(avs[1], i, FALSE);
+	    GvSV(PL_secondgv) = svp ? *svp : &PL_sv_undef;
+	    PUSHMARK(SP);
+	    PUTBACK;
+	    nret = call_sv(code, G_EVAL|G_ARRAY);
+            if (SvTRUE(ERRSV)) {
+                Safefree(buf);
+                croak("%s", SvPV_nolen(ERRSV));
+            }
+	    SPAGAIN;
+	    nitems += nret;
+	    if (nitems > alloc) {
+		alloc <<= 2;
+		Renew(buf, alloc, SV*);
+	    }
+	    for (j = nret-1; j >= 0; j--) {
+		/* POPs would return elements in reverse order */
+		buf[d] = sp[-j];
+		d++;
+	    }
+	    sp -= nret;
+	}
+	LEAVE;
+	EXTEND(SP, nitems);
+	p = buf;
+	for (i = 0; i < nitems; i++)
+	    ST(i) = *p++;
+
+	Safefree(buf);
+	XSRETURN(nitems);
+    }
+
+void
+_natatime_iterator ()
+    PROTOTYPE:
+    CODE:
+    {
+	int i;
+	int nret;
+
+	/* 'cv' is the hidden argument with which XS_List__MoreUtils__array_iterator (this XSUB)
+	 * is called. The closure_arg struct is stored in this CV. */
+
+	natatime_args *args = (natatime_args*)CvXSUBANY(cv).any_ptr;
+
+	nret = args->natatime;
+
+	EXTEND(SP, nret);
+
+	for (i = 0; i < args->natatime; i++) {
+	    if (args->curidx < args->nsvs) {
+		ST(i) = sv_2mortal(newSVsv(args->svs[args->curidx++]));
+	    }
+	    else {
+		XSRETURN(i);
+	    }
+	}
+
+	XSRETURN(nret);
+    }
+
+SV *
+natatime (n, ...)
+    int n;
+    PROTOTYPE: $@
+    CODE:
+    {
+	int i;
+	natatime_args * args;
+	HV *stash = gv_stashpv("List::MoreUtils_na", TRUE);
+
+	CV *closure = newXS(NULL, XS_List__MoreUtils__natatime_iterator, __FILE__);
+
+	/* must NOT set prototype on iterator:
+	 * otherwise one cannot write: &$it */
+	/* !! sv_setpv((SV*)closure, ""); !! */
+
+	New(0, args, 1, natatime_args);
+	New(0, args->svs, items-1, SV*);
+	args->nsvs = items-1;
+	args->curidx = 0;
+	args->natatime = n;
+
+	for (i = 1; i < items; i++)
+	    SvREFCNT_inc(args->svs[i-1] = ST(i));
+
+	CvXSUBANY(closure).any_ptr = args;
+	RETVAL = newRV_noinc((SV*)closure);
+
+	/* in order to allow proper cleanup in DESTROY-handler */
+	sv_bless(RETVAL, stash);
+    }
+    OUTPUT:
+	RETVAL
+
+void
+mesh (...)
+    PROTOTYPE: \@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@
+    CODE:
+    {
+	int i, j, maxidx = -1;
+	AV **avs;
+	New(0, avs, items, AV*);
+
+	for (i = 0; i < items; i++) {
+	    if(!arraylike(ST(i)))
+	       croak_xs_usage(cv,  "\\@;\\@\\@...");
+	    avs[i] = (AV*)SvRV(ST(i));
+	    if (av_len(avs[i]) > maxidx)
+		maxidx = av_len(avs[i]);
+	}
+
+	EXTEND(SP, items * (maxidx + 1));
+	for (i = 0; i <= maxidx; i++)
+	    for (j = 0; j < items; j++) {
+		SV **svp = av_fetch(avs[j], i, FALSE);
+		ST(i*items + j) = svp ? sv_2mortal(newSVsv(*svp)) : &PL_sv_undef;
+	    }
+
+	Safefree(avs);
+	XSRETURN(items * (maxidx + 1));
+    }
+
+void
+uniq (...)
+    PROTOTYPE: @
+    CODE:
+    {
+	I32 i;
+	IV count = 0, seen_undef = 0;
+	HV *hv = newHV();
+        SV **args = &PL_stack_base[ax];
+	SV *tmp = sv_newmortal();
+	sv_2mortal(newRV_noinc((SV*)hv));
+
+	/* don't build return list in scalar context */
+	if (GIMME_V == G_SCALAR) {
+	    for (i = 0; i < items; i++) {
+		SvGETMAGIC(args[i]);
+		if(SvOK(args[i])) {
+		    sv_setsv_nomg(tmp, args[i]);
+		    if (!hv_exists_ent(hv, tmp, 0)) {
+			++count;
+			hv_store_ent(hv, tmp, &PL_sv_yes, 0);
+		    }
+		}
+		else if(0 == seen_undef++) {
+		    ++count;
+		}
+	    }
+	    ST(0) = sv_2mortal(newSVuv(count));
+	    XSRETURN(1);
+	}
+
+	/* list context: populate SP with mortal copies */
+	for (i = 0; i < items; i++) {
+	    SvGETMAGIC(args[i]);
+	    if(SvOK(args[i])) {
+		SvSetSV_nosteal(tmp, args[i]);
+		if (!hv_exists_ent(hv, tmp, 0)) {
+		    /*ST(count) = sv_2mortal(newSVsv(ST(i)));
+		    ++count;*/
+		    args[count++] = args[i];
+		    hv_store_ent(hv, tmp, &PL_sv_yes, 0);
+		}
+	    }
+	    else if(0 == seen_undef++) {
+		args[count++] = args[i];
+	    }
+	}
+
+	XSRETURN(count);
+    }
+
+void
+singleton (...)
+    PROTOTYPE: @
+    CODE:
+    {
+	I32 i;
+	IV cnt = 0, count = 0, seen_undef = 0;
+	HV *hv = newHV();
+        SV **args = &PL_stack_base[ax];
+	SV *tmp = sv_newmortal();
+
+	sv_2mortal(newRV_noinc((SV*)hv));
+
+	for (i = 0; i < items; i++) {
+	    SvGETMAGIC(args[i]);
+	    if(SvOK(args[i])) {
+		HE *he;
+		SvSetSV_nosteal(tmp, args[i]);
+		he = hv_fetch_ent(hv, tmp, 0, 0);
+		if (NULL == he) {
+		    /* ST(count) = sv_2mortal(newSVsv(ST(i))); */
+		    args[count++] = args[i];
+		    hv_store_ent(hv, tmp, newSViv(1), 0);
+		}
+		else {
+		    SV *v = HeVAL(he);
+		    IV how_many = SvIVX(v);
+		    sv_setiv(v, ++how_many);
+		}
+	    }
+	    else if(0 == seen_undef++) {
+		args[count++] = args[i];
+	    }
+	}
+
+	/* don't build return list in scalar context */
+	if (GIMME_V == G_SCALAR) {
+	    for (i = 0; i < count; i++) {
+		if(SvOK(args[i])) {
+		    HE *he;
+			sv_setsv_nomg(tmp, args[i]);
+		    he = hv_fetch_ent(hv, tmp, 0, 0);
+		    if (he) {
+			SV *v = HeVAL(he);
+			IV how_many = SvIVX(v);
+			if( 1 == how_many )
+			    ++cnt;
+		    }
+		}
+		else if(1 == seen_undef) {
+		    ++cnt;
+		}
+	    }
+	    ST(0) = sv_2mortal(newSViv(cnt));
+	    XSRETURN(1);
+	}
+
+	/* list context: populate SP with mortal copies */
+	for (i = 0; i < count; i++) {
+	    if(SvOK(args[i])) {
+		HE *he;
+		SvSetSV_nosteal(tmp, args[i]);
+		he = hv_fetch_ent(hv, tmp, 0, 0);
+		if (he) {
+		    SV *v = HeVAL(he);
+		    IV how_many = SvIVX(v);
+		    if( 1 == how_many )
+			args[cnt++] = args[i];
+		}
+	    }
+	    else if(1 == seen_undef) {
+		args[cnt++] = args[i];
+	    }
+	}
+
+	XSRETURN(cnt);
+    }
+
+void
+minmax (...)
+    PROTOTYPE: @
+    CODE:
+    {
+	I32 i;
+	SV *minsv, *maxsv;
+
+	if (!items)
+	    XSRETURN_EMPTY;
+
+	minsv = maxsv = ST(0);
+
+        if (items == 1) {
+            EXTEND(SP, 1);
+            ST(0) = ST(1) = minsv;
+            XSRETURN(2);
+        }
+
+	for (i = 1; i < items; i += 2) {
+	    SV *asv = ST(i-1);
+	    SV *bsv = ST(i);
+	    int cmp = ncmp(asv, bsv);
+	    if (cmp < 0) {
+		int min_cmp = ncmp(minsv, asv);
+		int max_cmp = ncmp(maxsv, bsv);
+		if (min_cmp > 0) {
+		    minsv = asv;
+		}
+		if (max_cmp < 0) {
+		    maxsv = bsv;
+		}
+	    } else {
+		int min_cmp = ncmp(minsv, bsv);
+		int max_cmp = ncmp(maxsv, asv);
+		if (min_cmp > 0) {
+		    minsv = bsv;
+		}
+		if (max_cmp < 0) {
+		    maxsv = asv;
+		}
+	    }
+	}
+
+	if (items & 1) {
+	    SV *rsv = ST(items-1);
+	    if (ncmp(minsv, rsv) > 0) {
+		minsv = rsv;
+	    }
+	    else if (ncmp(maxsv, rsv) < 0) {
+		maxsv = rsv;
+	    }
+	}
+	ST(0) = minsv;
+	ST(1) = maxsv;
+
+	XSRETURN(2);
+    }
+
+void
+part (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+    dMULTICALL;
+    int i;
+    HV *stash;
+    GV *gv;
+    I32 gimme = G_SCALAR;
+    SV **args = &PL_stack_base[ax];
+    CV *_cv;
+
+    AV **tmp = NULL;
+    int last = 0;
+
+    if(!codelike(code))
+       croak_xs_usage(cv,  "code, ...");
+
+    if (items == 1)
+	XSRETURN_EMPTY;
+
+    _cv = sv_2cv(code, &stash, &gv, 0);
+    PUSH_MULTICALL(_cv);
+    SAVESPTR(GvSV(PL_defgv));
+
+    for(i = 1 ; i < items ; ++i) {
+	int idx;
+	GvSV(PL_defgv) = args[i];
+	MULTICALL;
+	idx = SvIV(*PL_stack_sp);
+
+	if (idx < 0 && (idx += last) < 0)
+	    croak("Modification of non-creatable array value attempted, subscript %i", idx);
+
+	if (idx >= last) {
+	    int oldlast = last;
+	    last = idx + 1;
+	    Renew(tmp, last, AV*);
+	    Zero(tmp + oldlast, last - oldlast, AV*);
+	}
+	if (!tmp[idx])
+	    tmp[idx] = newAV();
+	av_push(tmp[idx], args[i]);
+	SvREFCNT_inc(args[i]);
+    }
+    POP_MULTICALL;
+
+    EXTEND(SP, last);
+    for (i = 0; i < last; ++i) {
+        if (tmp[i])
+            ST(i) = sv_2mortal(newRV_noinc((SV*)tmp[i]));
+        else
+            ST(i) = &PL_sv_undef;
+    }
+
+    Safefree(tmp);
+    XSRETURN(last);
+}
+
+#if 0
+void
+part_dhash (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+    /* We might want to keep this dhash-implementation.
+     * It is currently slower than the above but it uses less
+     * memory for sparse parts such as
+     *   @part = part { 10_000_000 } 1 .. 100_000;
+     * Maybe there's a way to optimize dhash.h to get more speed
+     * from it.
+     */
+    dMULTICALL;
+    int i, j, lastidx = -1;
+    int max;
+    HV *stash;
+    GV *gv;
+    I32 gimme = G_SCALAR;
+    I32 count = 0;
+    SV **args = &PL_stack_base[ax];
+    CV *cv;
+
+    dhash_t *h = dhash_init();
+
+    if(!codelike(code))
+       croak_xs_usage(cv,  "code, ...");
+
+    if (items == 1)
+	XSRETURN_EMPTY;
+
+    cv = sv_2cv(code, &stash, &gv, 0);
+    PUSH_MULTICALL(cv);
+    SAVESPTR(GvSV(PL_defgv));
+
+    for(i = 1 ; i < items ; ++i) {
+	int idx;
+	GvSV(PL_defgv) = args[i];
+	MULTICALL;
+	idx = SvIV(*PL_stack_sp);
+
+	if (idx < 0 && (idx += h->max) < 0)
+	    croak("Modification of non-creatable array value attempted, subscript %i", idx);
+
+	dhash_store(h, idx, args[i]);
+    }
+    POP_MULTICALL;
+
+    dhash_sort_final(h);
+
+    EXTEND(SP, max = h->max+1);
+    i = 0;
+    lastidx = -1;
+    while (i < h->count) {
+	int retidx = h->ary[i].key;
+	int fill = retidx - lastidx - 1;
+	for (j = 0; j < fill; j++) {
+	    ST(retidx - j - 1) = &PL_sv_undef;
+	}
+	ST(retidx) = newRV_noinc((SV*)h->ary[i].val);
+	i++;
+	lastidx = retidx;
+    }
+
+    dhash_destroy(h);
+    XSRETURN(max);
+}
+
+#endif
+
+SV *
+bsearch (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+    dMULTICALL;
+    HV *stash;
+    GV *gv;
+    I32 gimme = GIMME_V; /* perl-5.5.4 bus-errors out later when using GIMME
+                            therefore we save its value in a fresh variable */
+    SV **args = &PL_stack_base[ax];
+
+    long i, j;
+    int val = -1;
+
+    if(!codelike(code))
+       croak_xs_usage(cv,  "code, ...");
+
+    if (items > 1) {
+	CV *_cv = sv_2cv(code, &stash, &gv, 0);
+	PUSH_MULTICALL(_cv);
+	SAVESPTR(GvSV(PL_defgv));
+
+        i = 0;
+        j = items - 1;
+        do {
+            long k = (i + j) / 2;
+
+            if (k >= items-1)
+                break;
+
+            GvSV(PL_defgv) = args[1+k];
+            MULTICALL;
+            val = SvIV(*PL_stack_sp);
+
+            if (val == 0) {
+                POP_MULTICALL;
+                if (gimme != G_ARRAY) {
+                    XSRETURN_YES;
+		}
+                SvREFCNT_inc(RETVAL = args[1+k]);
+                goto yes;
+            }
+            if (val < 0) {
+                i = k+1;
+            } else {
+                j = k-1;
+            }
+        } while (i <= j);
+        POP_MULTICALL;
+    }
+
+    if (gimme == G_ARRAY)
+        XSRETURN_EMPTY;
+    else
+        XSRETURN_UNDEF;
+yes:
+    ;
+}
+OUTPUT:
+    RETVAL
+
+int
+bsearchidx (code, ...)
+    SV *code;
+PROTOTYPE: &@
+CODE:
+{
+    dMULTICALL;
+    HV *stash;
+    GV *gv;
+    I32 gimme = GIMME_V; /* perl-5.5.4 bus-errors out later when using GIMME
+                            therefore we save its value in a fresh variable */
+    SV **args = &PL_stack_base[ax];
+
+    long i, j;
+    int val = -1;
+
+    if(!codelike(code))
+       croak_xs_usage(cv,  "code, ...");
+
+    RETVAL = -1;
+
+    if (items > 1) {
+	CV *_cv = sv_2cv(code, &stash, &gv, 0);
+	PUSH_MULTICALL(_cv);
+	SAVESPTR(GvSV(PL_defgv));
+
+        i = 0;
+        j = items - 1;
+        do {
+            long k = (i + j) / 2;
+
+            if (k >= items-1)
+                break;
+
+            GvSV(PL_defgv) = args[1+k];
+            MULTICALL;
+            val = SvIV(*PL_stack_sp);
+
+            if (val == 0) {
+                RETVAL = k;
+                break;
+            }
+            if (val < 0) {
+                i = k+1;
+            } else {
+                j = k-1;
+            }
+        } while (i <= j);
+        POP_MULTICALL;
+    }
+}
+OUTPUT:
+    RETVAL
+
+void
+_XScompiled ()
+    CODE:
+       XSRETURN_YES;