Re: Using Inline::C to Implement a binary search with callback (clobbering $a, $b, leaking)

[email protected] Thu, 15 Aug 2013 11:38:06 +1000
Newsgroups perl.inline
Message-ID <156A278B22854113B38BD2CF7CDD3231@OwnerPC311012>

-----Original Message----- 
From: David Oswald
Sent: Thursday, August 15, 2013 7:45 AM
To: inline
Subject: Using Inline::C to Implement a binary search with callback 
(clobbering $a, $b, leaking)

> I'm working on implementing a binary search using Inline::C.
>
> Eventually I want to be able to call it like this:
>
> my $found_ix = binary_search { $a <=> $b } @ordered_numbers;
>
> or
>
> my $found_ix = binary_search { $a cmp $b } @ordered_strings;
>
> Currently I've got it to this point:
>
> my $found = binary_search sub{ $a <=> $b }, \@ordered_numbers;
>
> ...in other words, I haven't worked on prototypes yet.  But at the
> moment the reason I'm writing is to ask about a couple of issues.
> First, I'm leaking memory.  I'm pretty sure it's not in the comparator
> sub, as I tested it in isolation with valgrind and came out ok after
> millions of iterations.
>
> But when I invoke binary_search and run 'top' in another process I see
> the memory consumption growing.
>
> Second, I'm clobbering $a and $b.  I thought that
> SV* save_scalar(GV *gv)
> would do the trick, but it expects a glob, and I'm grabbing $a and $b
> as scalars.
>
> Aside from a leak, and clobbering $a and $b, everything else works!
>
> Here's the code:
>
> use strict;
> use warnings;
> use Test::More;
>
> use Inline C => 'DATA';
>
>
> my @tests = (
>   [ 'Odd number of elements',  [ 2, 3, 5, 7, 11, 13, 17, 19, 23, 29,
> 31, 37, 41, 43, 53, 59, 61 ] ],
>   [ 'Even number of elements', [ 2, 3, 5, 7, 11, 13, 17, 19, 23, 29,
> 31, 37, 41, 43, 53, 59     ] ],
>   [ 'Single element',          [ 2
>                          ] ],
>   [ 'Two elements',            [ 2, 3
>                          ] ],
>   [ 'Empty list',              [
>                          ] ],
> );
>
> ( $a, $b ) = ( "Hello", "world" );
>
> for( 1 .. 1 ) {
>   foreach my $test ( @tests ) {
>     my( $name, $list ) = @{$test};
>     test_list( $name, $list );
>   }
> }
>
> is( "$a $b!", "Hello world!", "\$a and \$b are not clobbered." );
>
>
> done_testing();
>
> sub test_list {
>   my( $name, $aref ) = @_;
>   foreach my $needle ( 0 .. $#{$aref} + 2 ) {
>     my( $known_index ) = grep { $needle == $aref->[$_] } 0 .. $#{$aref};
>     my $found_index    = binary_search( sub{ $a <=> $b }, $needle, 
> $aref );
>     my $found = defined($found_index) ? "Found." : "Not found.";
>     is( $found_index, $known_index, "$name. Needle:$needle. $found" );
>   }
> }
>
> __DATA__
> __C__
>
> int comparator( SV*, SV*, SV* );
>
> SV* binary_search( SV* block, SV* needle, SV* aref_haystack ) {
>   I32 min = 0;
>   I32 max = 0;
>   if(
>        ! SvROK( aref_haystack )                 // We have a reference.
>     || SvTYPE(SvRV(aref_haystack)) != SVt_PVAV  // We have an array ref.
>   ) {
>     croak( "Argument must be an array ref.\n" );
>   }
>
>   max = av_top_index( (AV*)SvRV(aref_haystack) );
>   while( max > min ) {
>     I32 mid = ( min + max ) / 2;
>     SV* hay = *av_fetch( (AV*)SvRV(aref_haystack), mid, 0 ); // Fetch
> value at aref_haystack->[mid]
>     if( comparator(block,needle,hay) == 1 ) {  // If needle > hay.
>       min = mid + 1;
>     }
>     else {
>       max = mid;
>     }
>   }
>   if( max == min && comparator(block, needle, *av_fetch(
> (AV*)SvRV(aref_haystack),min,0) ) == 0 ) {
>     return newSViv(min);
>   }
>   return newSV(0); // undef: Not found.
> }
>
>
> int comparator ( SV* block, SV* needle, SV* hay ) {
>   int ret;
>   {
>     dSP;
>
>     int count;
>
>     ENTER;
>     SAVETMPS;
>
>     PUSHMARK(SP);
>     // We're not passing params.
>     PUTBACK;
>
>     sv_setsv(get_sv("a",0),needle);
>     sv_setsv(get_sv("b",0),hay);
>
>     count = call_sv(block, G_SCALAR);
>
>     SPAGAIN;
>
>     if (count != 1)
>       croak("Callback had improper return value count.\n");
>
>     ret = POPi;
>
>     PUTBACK;
>     FREETMPS;
>     LEAVE;
>   }
>   return ret;
> }
>
>
> So, if anyone knows what I ought to try in eliminating the leak, or to
> avoid clobbering $a and $b, I'd appreciate hearing.

Hi Dave,

A few things I noticed:

1) The XS file that gets generated by Inline::C always contains "PROTOTYPES: 
DISABLE". I'm not sure how that will impact upon your wish to use 
prototyping, but it doesn't "feel" very promising to me. The inclusion of 
"int comparator( SV*, SV*, SV* );" in the code doesn't have any effect (that 
I could detect) - but you're probably aware of that anyway.

2) For portability, I would use /* and */ for comments in C code, instead of 
//. (I think there are still C compilers out there that won't interpret // 
as you intend.)

3) If you want, you can return undef from XS with "return &PL_sv_undef;". 
(This, according to perlapi, is the recommended way - no need to return 
newSV(0) as a substitute.)

I think there's a lot going on here that doesn't have much to do with 
Inline::C specifically - I'd be taking it to perlmonks where you'll get 
access to that broader experience. (I think providing them with the 
Inline::C demo(s) would is the way to go.)
That's not to say you won't get excellent help here - someone here might 
well come up with the answers you need.

Personally, I've not used call_sv() before, and I'd need to do a bit of 
researching before *I* could provide anything useful to you - by which time 
you'll probably have worked it out for yourself. (It's interesting - and 
I'll certainly be looking at this further tonight.)

Cheers,
Rob