Daniel McBrearty wrote:
> I wrote a script today that started a thread that was polling every
> 1000ms. I used
>
> use Time::HiRes qw( usleep );
> usleep(1000 * 1000);
>
> I didn't get the stopwatch out, but it looked as if the timing was way
> off. As I need to scale to much shorter timings, I need to use this
> module.
>
> Does anyone else have this experience and know why it is so?
Works for me - the longer the time, the more accurate it should be since
timers don't have the same resolution that clocks do. I think they're
accurate to 10-15 msec on Intel and use message passing which could affect
shorter times. You can also use Win32::GetTickCount for a possibly more
accurate resolution (not a timer per se). QueryPerformanceCounter /
QueryPerformanceFrequency can access an 8 usec counter if avail. I have
some code after this snippet that you could try if you need to time a
chunk of code accurately - just call start_PC_timer before and stop_PC_timer
after.
Try this and see what you get (also try varying the time - I'm using
10 secs below):
use strict;
use warnings;
use Time::HiRes qw(usleep);
for (1 .. 10) {
my $pt0 = Win32::GetTickCount ();
usleep ($_ * 1000 * 1000);
printf "%.3f seconds\n", (Win32::GetTickCount () - $pt0) / 1000;
}
__END__
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
use strict;
use warnings;
use Win32::API;
my $QueryPerformanceCounter; # API function obj once set in PC_init
my $QueryPerformanceFrequency; # API function obj once set in PC_init
my $PC_Freq; # computed performance counter freq in seconds
my $QPC_Ovhd; # computed overhead of QPC API call in seconds
sub init_PC { # set 4 global vrbls for using timing routines
return if $QueryPerformanceCounter;
$QueryPerformanceCounter = new Win32::API('kernel32',
'QueryPerformanceCounter', [qw(P)], 'I') or die
'Failed to get QueryPerformanceCounter:', Win32::FormatMessage (
Win32::GetLastError ()); # set global
$QueryPerformanceFrequency = new Win32::API('kernel32',
'QueryPerformanceFrequency', [qw(P)], 'I') or die
'Failed to get QueryPerformanceFrequency:', Win32::FormatMessage (
Win32::GetLastError ()); # set global
my $Freq = pack 'I2', 0;
if (not $QueryPerformanceFrequency->Call($Freq)) {
die 'QueryPerformanceFrequency call failed:',
Win32::FormatMessage (Win32::GetLastError ());
}
my @Freq = reverse unpack 'I2', $Freq;
$PC_Freq = $Freq[0] * 2**32 + $Freq[1]; # set global
printf "QueryPerformanceCounter freq: 1/%u sec\n\n", $PC_Freq if $debug;
$QPC_Ovhd = get_QPC_overhead (); # set global
}
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub get_QPC_overhead {
my $Ctr1 = pack 'I2', 0;
my $Ctr2 = pack 'I2', 0;
if (not $QueryPerformanceCounter->Call($Ctr1)) {
die 'QueryPerformanceCounter call failed:',
Win32::FormatMessage (Win32::GetLastError ());
}
my $max_loops = 100; # adjust down to lower overhead
my $total = 0;
for (1 .. $max_loops) {
$QueryPerformanceCounter->Call($Ctr1);
$QueryPerformanceCounter->Call($Ctr2);
my @Ctr1 = reverse unpack 'I2', $Ctr1;
my @Ctr2 = reverse unpack 'I2', $Ctr2;
printf "Start Value: %u, %u\n", $Ctr1[0], $Ctr1[1] if $debug;
printf "End Value: %u, %u\n", $Ctr2[0], $Ctr2[1] if $debug;
my $diff = ($Ctr2[0] * 2**32 + $Ctr2[1]) -
($Ctr1[0] * 2**32 + $Ctr1[1]);
printf "diff: %u / freq: %u = %f\n\n", $diff, $PC_Freq,
$diff / $PC_Freq if $debug;
$total += $diff;
}
my $ovhd = $total / $max_loops / $PC_Freq;
printf "API Overhead: %.8f seconds\n", $ovhd if $debug;
return $ovhd
}
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub start_PC_timer {
init_PC ();
my $Ctr1 = pack 'I2', 0;
$QueryPerformanceCounter->Call($Ctr1);
my @Ctr1 = reverse unpack 'I2', $Ctr1;
return [EMAIL PROTECTED];
}
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub stop_PC_timer {
my $Ctr1ref = shift;
my $Ctr2 = pack 'I2', 0;
$QueryPerformanceCounter->Call($Ctr2);
my @Ctr2 = reverse unpack 'I2', $Ctr2;
my $diff = ($Ctr2[0] * 2**32 + $Ctr2[1]) - ($Ctr1ref->[0] * 2**32 +
$Ctr1ref->[1]);
my $et = ($diff - $QPC_Ovhd) / $PC_Freq;
printf "Elapsed time: %f\n", $et if $debug;
return $et;
}
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
_______________________________________________
Perl-Win32-Users mailing list
[email protected]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
