RE: how to make it to run faster

[Su, Yu (Eugene)]

Beautiful!!! It cuts the run time from ~43 seconds to less than 4 seconds for 
one of my data files!
I knew someone out there can do a better job. For this particular purpose, 
using vec() and bitwise operation instead of unpacking and packing is a much 
better way.

Thank Tobias for this excellent solution.

-Eugene

-----Original Message-----
From: Tobias Hoellrich [mailto:[EMAIL PROTECTED]
Sent: Tuesday, March 13, 2007 2:35 PM
To: Su, Yu (Eugene)
Cc: Perl-Win32-Users@listserv.ActiveState.com
Subject: RE: how to make it to run faster


This one runs about 10-15 times faster on my system. Toggle $useVec to
alternate between your old version and the one that uses vec(). Please
not that vec() is big-endian. I verified that the output of both
versions are identical.

Hope that helps
  Tobias

use strict;
use warnings;
my $header;
my $header_size=8*1024;
my $body;
my $body_size=2048*2048*2;
my $image=$ARGV[0];
open(FH, "+<$image") or die "\nCan not open $image for updating: $!\n"; 
read(FH, $header, $header_size) == $header_size or print "\nshort read:
$!\n";
read(FH, $body, $body_size) == $body_size or print "\nshort read: $!\n";

my $useVec=1;

if($useVec) {
  my $changed=0;
  for my $i (0 .. $body_size/2) {
    next unless (vec($body,$i,16)>>8 & 1);
    $changed++;
    vec($body,$i,16) = 1<<8;
  }
  if($changed) {
    seek FH, 0, 0; 
    print FH $header, $body; 
    close(FH);
  }
} else {
  my $body_new; 
  my $p;
  foreach $p (unpack("S*",$body)) {
    if ($p&1) {$p=1};
    $body_new=$body_new.pack("S",$p); # packing is slow ~40 seconds
  } 
  seek FH, 0, 0; 
  print FH $header, $body_new; 
  close(FH); 
}

-----Original Message-----
From: [EMAIL PROTECTED]
[mailto:[EMAIL PROTECTED] On Behalf Of
Bharucha, Nikhil
Sent: Tuesday, March 13, 2007 2:54 PM
To: Su, Yu (Eugene); Perl-Win32-Users@listserv.ActiveState.com
Subject: RE: how to make it to run faster

I believe the pack function is implemented in C so I don't know how much
faster you can write it...
_______________________________________________
Perl-Win32-Users mailing list
Perl-Win32-Users@listserv.ActiveState.com
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs