split1                  5.09/s
moritz_r                26.8/s
moritz_r_inplace        26.8/s
substr1                 27.8/s
vec                     39.7/s
ikegami_s               41.0/s
avar                     763/s
corion                   809/s
avar_inplace             919/s
nijo                     932/s
ikegami_tr               940/s
avar_pos_inplace        1367/s
avar_pos                1400/s
moritz                  1673/s
moritz_r_length         1688/s
moritz_r_length_inplace 1773/s
moritz_inplace          1786/s
swap                    3208/s
avar_c_inplace          3224/s
avar_tye_c_inplace      3239/s
diotalevi               9907/s

##</code><code>##

#!/usr/bin/perl

use 5.6.0;

use strict;
use warnings FATAL => 'all';

use Benchmark qw( cmpthese );

#use blib;
#use Avar;

use Inline C => q[
void avar_c_inplace(SV *sv1, SV *sv2)
{
    char *sv1p, *sv2p;
    STRLEN sv1len, sv2len;
    SV *sv1_sv;
    STRLEN i;

    if (!SvROK(sv1) || !SvPOK((SV*)SvRV(sv1)) || !SvPOK(sv2)) {
        croak("Usage: avar_cee(\$s1, $s2)");
    }

    sv1_sv = (SV*)SvRV(sv1);
    sv1p = SvPV(sv1_sv, sv1len);
    sv2p = SvPV(sv2,    sv2len);

    if (sv1len != sv2len) {
       croak("The given strings must be of the same length");
    }

    for (i = 0; i < sv2len; i++) {
        if (sv1p[i] == '\0') {
            sv1p[i] = sv2p[i];
        }
    }
}


void avar_tye_c_inplace(SV *sv1, SV *sv2)
{
    char *sv1p, *sv2p;
    STRLEN sv1len, sv2len;
    SV *sv1_sv;
    STRLEN i;

    if (!SvROK(sv1) || !SvPOK((SV*)SvRV(sv1)) || !SvPOK(sv2)) {
        croak("Usage: avar_cee(\$s1, $s2)");
    }

    sv1_sv = (SV*)SvRV(sv1);
    sv1p = SvPV(sv1_sv, sv1len);
    sv2p = SvPV(sv2,    sv2len);

    if (sv1len != sv2len) {
       croak("The given strings must be of the same length");
    }

    char *pSrc = sv2p + sv2len;
    char *pDst = sv1p + sv2len;

    while (sv2p <= pSrc) {
        if (!*pDst) {
            *pDst = *pSrc;
        }
        --pSrc;
        --pDst;
    }
}

SV* swap(SV* one, SV* two) {
    char *buf1, *buf2, *buf3;
    STRLEN idx, len;
    SV* ret;

    if (!SvPOK(one) || !SvPOK(two) || sv_len(one) > sv_len(two))
        return newSVsv(&PL_sv_undef);

    len = sv_len(one);
    buf1 = SvPVX(one);
    buf2 = SvPVX(two);
    buf3 = malloc(len);

    for (idx=0; idx < len; idx++) {
        buf3[idx] = buf1[idx] ? buf1[idx] : buf2[idx];
    }

    ret = newSVpv(buf3, len);
    free(buf3);
    return ret;
}
];

BEGIN {
	package diotalevi;
	local @diotalevi::ISA;

	my $c_src = <<'XS';
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include <string.h>

MODULE = diotalevi PACKAGE = diotalevi PREFIX = diotalevi_

void
diotalevi_diotalevi(dsv_rv, ssv_rv)
		SV *dsv_rv
		SV *ssv_rv
	INIT:
		SV *dsv;
		SV *ssv;
		STRLEN len;
		char *dsvc;
		char *ssvc;
		char *ptr;
		char *ptr_end;
	CODE:
		if ( ! ( dsv_rv && ssv_rv && SvRV( dsv_rv ) && SvRV( ssv_rv ) && SvPOK(SvRV(dsv_rv)) && SvPOK(SvRV(ssv_rv))))
			croak( "Blaaa" );

		/* Fetch my SVs */
		dsv = SvRV( dsv_rv );
		ssv = SvRV( ssv_rv );

		/* Fetch my (char*)s. */
		dsvc = SvPVX( dsv );
		ssvc = SvPVX( ssv );

		/* Operate only on the minimum length. */
		len =	SvCUR( dsv ) < SvCUR( ssv )
			?	SvCUR( dsv )
			:	SvCUR( ssv );

		/* Establish bounds. */
		ptr     = dsvc;
		ptr_end = dsvc + len;

		/* Do it. */
		while ( 1 ) {
			ptr = memchr( ptr, '\0', ptr_end - ptr );

			if ( ! ( ptr && ptr < ptr_end ) )
				break;

			*ptr = *(ptr - dsvc + ssvc);

			++ ptr;
		}

XS

	Inline->bind(
		C => $c_src,
		NAME => 'diotalevi',
		XSMODE => 1,
	);

	*main::diotalevi = \&diotalevi::diotalevi;
}


my $s1 = do_rand(0, 100_000);
my $s2 = do_rand(1, 100_000);
#my $s1 = "a\0b\0c\0d\0";
#my $s2 = "aXbYcZdA";

my @z = $s1 =~ m/(\0)/g;
my $num = @z;
warn "\$s1 has $num zeroes";

my %subs = (
    'split1'     => sub { my $cp = $s1; my $s3 = split1( $s1, $s2 ) },
    'substr1'    => sub { my $cp = $s1; my $s3 = substr1( $s1, $s2 ) },
#    'kyle'       => sub { my $cp = $s1; my $s3 = kyle( $s1, $s2 ) },
    'moritz'     => sub { my $cp = $s1; my $s3 = moritz( $s1, $s2 ) },
    'moritz_inplace'     => sub { my $cp = $s1; moritz_inplace( \$cp, $s2 ); $cp },
    'moritz_r'     => sub { my $cp = $s1; my $s3 = moritz_r( $s1, $s2 ) },
    'moritz_r_inplace'     => sub { my $cp = $s1; moritz_r_inplace( \$cp, $s2 ); $cp },
    'moritz_r_length'     => sub { my $cp = $s1; my $s3 = moritz_r_length( $s1, $s2 ) },
    'moritz_r_length_inplace'     => sub { my $cp = $s1; moritz_r_length_inplace( \$cp, $s2 ); $cp },
    'corion'     => sub { my $cp = $s1; my $s3 = corion( $s1, $s2 ) },
    'ikegami_s'  => sub { my $cp = $s1; my $s3 = ikegami_s( $s1, $s2 ) },
    'ikegami_tr' => sub { my $cp = $s1; my $s3 = ikegami_tr( $s1, $s2 ) },
    'avar'       => sub { my $cp = $s1; my $s3 = avar( $s1, $s2 ) },
    'avar_inplace'  => sub { my $cp = $s1; avar_inplace( \$cp, $s2 ); $cp },
    'avar_pos'  => sub { my $cp = $s1; my $s3 = avar_pos( $s1, $s2 ) },
    'avar_pos_inplace'  => sub { my $cp = $s1; avar_pos_inplace( \$cp, $s2 ); $cp },
    'avar_c_inplace'  => sub { my $cp = $s1; avar_c_inplace( \$cp, $s2 ); $cp },
    'avar_tye_c_inplace'  => sub { my $cp = $s1; avar_tye_c_inplace( \$cp, $s2 ); $cp },
    'diotalevi' => sub { my $cp = $s1; diotalevi(\$cp, \$s2); $cp },
    'swap'  => sub { my $s3 = swap( $s1, $s2 ) },
    'vec'  => sub { my $s3 = using_vec( $s1, $s2 ) },
    'nijo'  => sub { my $s3 = nijo( $s1, $s2 ) },
);

cmpthese( -2, \%subs );

use Test::More;

plan 'tests' => scalar keys %subs;

my $correct;
{
    my $tmp = $s1;
    avar_pos_inplace(\$tmp, $s2);
    $correct = $tmp;
}

foreach my $subname ( keys %subs ) {
    my $sub = $subs{$subname};
    ok($sub->() eq $correct, "$subname returned the correct value");
}

sub split1 {
    my ($s1, $s2) = @_;

    my @s1 = split //, $s1;
    my @s2 = split //, $s2;

    foreach my $idx ( 0 .. $#s1 ) { 
	if ( $s1[$idx] eq chr(0) ) { 
	    $s1[$idx] = $s2[$idx];
	} 
    } 

    return join '', @s1;
}

sub substr1 {
    my ($s1, $s2) = @_;

    for my $idx ( 0 .. length($s1) ) {
	if ( substr($s1,$idx,1) eq chr(0) ) {
	    substr($s1, $idx, 1) = substr($s2, $idx, 1);
	}
    } 

    return $s1;
} 

sub kyle {
    my ($s1, $s2) = @_;

    my $out = $s1;
    while ( $s1 =~ m/\000/g ) {
	my $pos = pos;
	substr( $out, $pos, 1 ) = substr( $s2, $pos, 1 );
    }

    return $out;
}

sub moritz {
    my ($s1, $s2) = @_;

    my $pos = 0;
    while ( -1 < ( $pos = index $s1, "\000", $pos ) ) {
        substr( $s1, $pos, 1 ) = substr( $s2, $pos, 1 );
    }

    return $s1;
}

sub moritz_inplace {
    my ($s1, $s2) = @_;

    my $pos = 0;
    while ( -1 < ( $pos = index $$s1, "\000", $pos ) ) {
        substr( $$s1, $pos, 1 ) = substr( $s2, $pos, 1 );
    }
}

sub moritz_r {
    my ($s1, $s2) = @_;

    while ((my $pos = rindex $s1, "\000") != -1) {
        substr( $s1, $pos, 1 ) = substr( $s2, $pos, 1 );
    }

    return $s1;
}

sub moritz_r_inplace {
    my ($s1, $s2) = @_;

    while ((my $pos = rindex $$s1, "\000") != -1) {
        substr( $$s1, $pos, 1 ) = substr( $s2, $pos, 1 );
    }
}

sub moritz_r_length {
    my ($s1, $s2) = @_;

    my $pos = length $s1;
    while (($pos = rindex $s1, "\000", $pos) != -1) {
        substr( $s1, $pos, 1 ) = substr( $s2, $pos, 1 );
    }

    return $s1;
}

sub moritz_r_length_inplace {
    my ($s1, $s2) = @_;

    my $pos = length $$s1;
    while (($pos = rindex $$s1, "\000", $pos) != -1) {
        substr( $$s1, $pos, 1 ) = substr( $s2, $pos, 1 );
    }
}
sub ikegami_s {
    my ($s1, $s2) = @_;
    (my $mask = $s1) =~ s/[^\x00]/\xFF/g;
    return ($s1 & $mask) | ($s2 & ~$mask);
}

sub ikegami_tr {
   my ($s1, $s2) = @_;
   (my $mask = $s1) =~ tr/\x00/\xFF/c;
   return ($s1 & $mask) | ($s2 & ~$mask);
}

sub corion {
   my ($s1, $s2) = @_;

   my $ofs = 0;
   return join "", map { $ofs += length; $_ => substr $s2, $ofs++, 1 } split /\0/, $s1, -1;
}

sub avar_pos {
    my ($s1, $s2) = @_;

    use bytes;
    $s1 =~ s/\0/substr $s2, pos($s1), 1/eg;

    return $s1;
}

sub avar_pos_inplace {
    my ($s1, $s2) = @_;

    use bytes;
    $$s1 =~ s/\0/substr $s2, pos($$s1), 1/eg;
}

sub avar {
    my ($s1, $s2) = @_;

    use bytes;
    $s1 =~ s/\0/substr $s2, $-[0], 1/eg;

    return $s1;
}

sub avar_inplace {
    my ($s1, $s2) = @_;

    use bytes;
    $$s1 =~ s/\0/substr $s2, $-[0], 1/eg;
}

sub using_vec {
   my ($s1, $s2) = @_;
   vec($s1, $_, 8) ||= vec($s2, $_, 8) for 0 .. length($s1)-1;
   return $s1;
}

sub nijo {
    use bytes;
    my ($s1, $s2) = @_;
    my $idx = 0;
    my $len;

    my @chunks = split /\0/, $s1;

    foreach my $chunk (@chunks) {
        $len = length($chunk);
        substr ($s2, $idx, $len) = $chunk;
        $idx = $idx + 1 + $len;
    }
    return $s2;
}

# This makes sure that $s1 has chr(0)'s in it and $s2 does not.
sub do_rand {
    my $min = shift;
    my $len = shift;
    my $n = "";
    for (1 .. $len)
    {
        $n .= chr( rand(255-$min)+$min );
    }
    return $n;
}

#sub do_rand {
#    my $n = (shift) ? int(rand(255)) : int(rand(254)) + 1;
#    return chr( $n );
#}

__END__