use strict; use warnings; use 5.020; use threads; use Encode qw/ decode /; say "No thread (byte)\n---------"; say 'Count: ', scalar @{ test( 1 )}; say "\nThread (byte)\n---------"; say 'Count: ', scalar @{ threads-> create( \&test, 1 )-> join }; say "\nNo thread (short)\n---------"; say 'Count: ', scalar @{ test( 2 )}; say "\nThread (short)\n---------"; say 'Count: ', scalar @{ threads-> create( \&test, 2 )-> join }; sub test { my $arg = shift; open my $fh, '<', "fname-$arg"; binmode $fh; my $str = do { local $/; <$fh> }; close $fh; $str = decode( 'UTF16LE', $str ) if $arg == 2; my ( $w, $h ) = ( 7616, 1200 ); my @b = map { [ [ $w, 0 ], [ $h, 0 ] ] } 0 .. 145; my $t = time; for my $y ( 0 .. $h - 1 ) { my $s = substr( $str, $y * $w, $w ); while( $s =~ m[[^\0]+]g ) { my $c = ord( $& ); $b[ $c ][ 0 ][ 0 ] = $-[0] if $-[0] < $b[ $c ][ 0 ][ 0 ]; $b[ $c ][ 0 ][ 1 ] = $+[0] - 1 if $+[0] - 1 > $b[ $c ][ 0 ][ 1 ]; $b[ $c ][ 1 ][ 0 ] = $y if $y < $b[ $c ][ 1 ][ 0 ]; $b[ $c ][ 1 ][ 1 ] = $y if $y > $b[ $c ][ 1 ][ 1 ]; } } say 'Time: ', time - $t; shift @b; return \@b; }