Benchmarking regexes

[Brent Dax]

I wrote a _very_ simple benchmark program to compare Perl 5 and Parrot.
Here's the result of a test run on my machine:

C:\brent\Visual Studio Projects\Perl 6\parrot\parrot>..\benchmark
Benchmarking "bbcdefg" =~ /b[cde]*.f/...
     perl: 0.03000 seconds for 10_000 iters
   parrot: 0.24100 seconds for 10_000 iters
Best: perl, worst: parrot. Spread of 0.21100.

The program is attached; it requires my latest regex patch to work.  You
may need to tr{\\}{/} in a few places to get it to work on Unix systems.

--Brent Dax
[EMAIL PROTECTED]
Parrot Configure pumpking and regex hacker

<obra> mmmm. hawt sysadmin chx0rs
<lathos> This is sad. I know of *a* hawt sysamin chx0r.
<obra> I know more than a few.
<lathos> obra: There are two? Are you sure it's not the same one?

use strict; use warnings;
use IPC::Open2;
use Time::HiRes qw(time);

print qq{Benchmarking "bbcdefg" =~ /b[cde]*.f/...\n};

my(%before, %after, %time);

($before{perl}, $after{perl})=doperl(<<'END');
use Time::HiRes qw(time);
my($iter)=10000;
print time;
print "\n";
$_="bbcdefg";

TOP:
        die "The impossible happened!" unless(/b[cde]*.f/);
        
        $iter--;
        goto TOP if $iter;

print time;
print "\n";
END

($before{parrot}, $after{parrot})=doparrot(<<'END');
        set I0, 10000
        rx_makebmp P1, "cde"
        rx_allocinfo P0, "bbcdefg"
        
        time N0
        print N0
        print "\n"
$top:
        bsr RX_0
        rx_info_successful P0, I1
        eq I1, 0, $panic
        rx_clearinfo P0, "bbcdefg"
        dec I0
        if I0, $top

        rx_freeinfo P0
        time N0
        print N0
        print "\n"
        end
$panic:
        print 2, "The impossible happened!\n"
        end

RX_0:
        rx_setprops P0, "i", 3  #used to make it process the same number of chars as 
/r branch $start
        branch $start
$advance:
        rx_advance P0, $fail
$start:
        rx_literal P0, "b", $advance
        rx_pushmark P0
$top:
        rx_oneof_bmp P0, P1, $next
        rx_pushindex P0
        branch $top
$back:
        rx_popindex P0, $advance
$next:
        rx_dot P0, $back
        rx_literal P0, "f", $back
        
        rx_succeed P0
        ret

$fail:
        rx_fail P0
        ret
        
END

for(keys %before) {
        $time{$_}=$after{$_}-$before{$_};
}

for(sort { $time{$a} <=> $time{$b} } keys %time) {
        printf("%9s: %5.5f seconds for 10_000 iters\n", $_, $time{$_});
}

my($best, $worst)=(sort { $time{$a}<=>$time{$b} } keys %time)[0, -1];

my($spread)=-($time{$best}-$time{parrot});

printf('Best: %s, worst: %s. Spread of %5.5f.', $best, $worst, $spread);

sub doparrot {
        no warnings 'uninitialized';
        my($code, $flags)=@_;
        
        open(ASM, "|perl assemble.pl - >rxtest.pbc");
        print ASM $code;
        close(ASM);
        
        return `.\\test_parrot $flags rxtest.pbc`;
}

sub doperl {
        no warnings 'uninitialized';
        my($code, $flags)=@_;
        
        open(CODE, ">rxtest.pl");
        print CODE "#!perl $flags\n";
        print CODE $code;
        close(CODE);

        return `.\\rxtest.pl`;
}