From: Rafael Garcia-Suarez Date: Sun, 22 Aug 2004 19:14:57 +0000 (+0000) Subject: Upgrade to Time::HiRes 1.61 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4ed0e2d49dad0e74ad5827a8f6a88b6fca190b58;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Time::HiRes 1.61 p4raw-id: //depot/perl@23232 --- diff --git a/ext/Time/HiRes/Changes b/ext/Time/HiRes/Changes index 7b64ee1..3dd17ae 100644 --- a/ext/Time/HiRes/Changes +++ b/ext/Time/HiRes/Changes @@ -1,5 +1,24 @@ Revision history for Perl extension Time::HiRes. +1.61 + - Win32: reset reading from the performance counters every + five minutes to better track wall clock time (thanks to + PC timers being often quite bad), should help long-running + programs. + +1.60 + - Win32: Patch from Steve Hay + [PATCH] Re: [perl #30755] [Win32] Different results from Time::HiRes::gettimeofdayunder the debugger + to [perl #30755] reported by Nigel Sandever + + - Cygwin: Use the Win32 recalibration code also in Cygwin if the + APIs are available. Cygwin testing by + Yitzchak Scott-Thoennes. + + - Solaris: use -lposix4 to get nanosleep for Solaris 2.6, + after that keep using -lrt, patch from Alan Burlison, + bug reported in [cpan #7165] + 1.59 - Change the Win32 recalibration limit to 0.5 seconds and tweak the documentation to blather less about the gory details of the @@ -21,7 +40,7 @@ Revision history for Perl extension Time::HiRes. perl change #22258) 1.55 - - Windows: ming32 patch from Mike Pomraning (use Perl's Const64() + - Windows: mingw32 patch from Mike Pomraning (use Perl's Const64() instead of VC-specific i64 suffix) 1.54 diff --git a/ext/Time/HiRes/HiRes.pm b/ext/Time/HiRes/HiRes.pm index 98d3142..8dc4a19 100644 --- a/ext/Time/HiRes/HiRes.pm +++ b/ext/Time/HiRes/HiRes.pm @@ -15,7 +15,7 @@ require DynaLoader; d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer d_nanosleep); -$VERSION = '1.59'; +$VERSION = '1.61'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -83,31 +83,34 @@ Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers =head1 DESCRIPTION -The C module implements a Perl interface to the C, -C, C, and C/C system calls, in other -words, high resolution time and timers. See the L section below -and the test scripts for usage; see your system documentation for the -description of the underlying C or C, C, -C, and C/C calls. +The C module implements a Perl interface to the +C, C, C, and C/C +system calls, in other words, high resolution time and timers. See the +L section below and the test scripts for usage; see your +system documentation for the description of the underlying +C or C, C, C, and +C/C calls. If your system lacks C or an emulation of it you don't -get C or the one-argument form of C. If your system lacks all of -C, C, and C, you don't get -C or C. If your system lacks both -C and C you don't get -C or C. +get C or the one-argument form of C. +If your system lacks all of C, C, and +C, you don't get C or +C. If your system lacks both C and +C you don't get C or +C. If you try to import an unimplemented function in the C statement it will fail at compile time. -If your subsecond sleeping is implemented with C instead of -C, you can mix subsecond sleeping with signals since -C does not use signals. This, however is unportable, and you -should first check for the truth value of C<&Time::HiRes::d_nanosleep> to -see whether you have nanosleep, and then carefully read your -C C API documentation for any peculiarities. (There is no -separate interface to call C; just use C -or C with small enough values.) +If your subsecond sleeping is implemented with C instead +of C, you can mix subsecond sleeping with signals since +C does not use signals. This, however is unportable, and +you should first check for the truth value of +C<&Time::HiRes::d_nanosleep> to see whether you have nanosleep, and +then carefully read your C C API documentation for any +peculiarities. (There is no separate interface to call +C; just use C or +C with small enough values.) Unless using C for mixing sleeping with signals, give some thought to whether Perl is the tool you should be using for work @@ -159,15 +162,15 @@ B: Since Sunday, September 9th, 2001 at 01:46:40 AM GMT, when the C seconds since epoch rolled over to 1_000_000_000, the default floating point format of Perl and the seconds since epoch have conspired to produce an apparent bug: if you print the value of -C you seem to be getting only five decimals, not six -as promised (microseconds). Not to worry, the microseconds are there -(assuming your platform supports such granularity in first place). -What is going on is that the default floating point format of Perl -only outputs 15 digits. In this case that means ten digits before the -decimal separator and five after. To see the microseconds you can use -either C/C with C<"%.6f">, or the C function in -list context, which will give you the seconds and microseconds as two -separate values. +C you seem to be getting only five decimals, not +six as promised (microseconds). Not to worry, the microseconds are +there (assuming your platform supports such granularity in first +place). What is going on is that the default floating point format of +Perl only outputs 15 digits. In this case that means ten digits +before the decimal separator and five after. To see the microseconds +you can use either C/C with C<"%.6f">, or the +C function in list context, which will give you the +seconds and microseconds as two separate values. =item sleep ( $floating_seconds ) @@ -206,21 +209,22 @@ In scalar context, the remaining time in the timer is returned. In list context, both the remaining time and the interval are returned. -There are usually three or four interval timers available: the C<$which> -can be C, C, C, or C. -Note that which ones are available depends: true UNIX platforms usually -have the first three, but (for example) Win32 and Cygwin have only -C, and only Solaris seems to have C (which is -used to profile multithreaded programs). +There are usually three or four interval timers available: the +C<$which> can be C, C, C, or +C. Note that which ones are available depends: true +UNIX platforms usually have the first three, but (for example) Win32 +and Cygwin have only C, and only Solaris seems to have +C (which is used to profile multithreaded programs). C results in C-like behavior. Time is counted in I; that is, wallclock time. C is delivered when the timer expires. -C counts time in (process) I; that is, only -when the process is running. In multiprocessor/user/CPU systems this -may be more or less than real or wallclock time. (This time is also -known as the I.) C is delivered when the timer expires. +C counts time in (process) I; that is, +only when the process is running. In multiprocessor/user/CPU systems +this may be more or less than real or wallclock time. (This time is +also known as the I.) C is delivered when the +timer expires. C counts time when either the process virtual time or when the operating system is running on behalf of the process (such as I/O). diff --git a/ext/Time/HiRes/HiRes.xs b/ext/Time/HiRes/HiRes.xs index 3505bf4..380077a 100644 --- a/ext/Time/HiRes/HiRes.xs +++ b/ext/Time/HiRes/HiRes.xs @@ -5,10 +5,14 @@ extern "C" { #include "EXTERN.h" #include "perl.h" #include "XSUB.h" +#if defined(__CYGWIN__) && defined(HAS_W32API_WINDOWS_H) +# include +# define CYGWIN_WITH_W32API +#endif #ifdef WIN32 -#include +# include #else -#include +# include #endif #ifdef HAS_SELECT # ifdef I_SYS_SELECT @@ -117,7 +121,7 @@ sv_2pv_nolen(pTHX_ register SV *sv) #endif /* Though the cpp define ITIMER_VIRTUAL is available the functionality - * is not supported in Cygwin as of August 2002, ditto for Win32. + * is not supported in Cygwin as of August 2004, ditto for Win32. * Neither are ITIMER_PROF or ITIMER_REALPROF implemented. --jhi */ #if defined(__CYGWIN__) || defined(WIN32) @@ -128,14 +132,14 @@ sv_2pv_nolen(pTHX_ register SV *sv) /* 5.004 doesn't define PL_sv_undef */ #ifndef ATLEASTFIVEOHOHFIVE -#ifndef PL_sv_undef -#define PL_sv_undef sv_undef -#endif +# ifndef PL_sv_undef +# define PL_sv_undef sv_undef +# endif #endif #include "const-c.inc" -#ifdef WIN32 +#if defined(WIN32) || defined(CYGWIN_WITH_W32API) #ifndef HAS_GETTIMEOFDAY # define HAS_GETTIMEOFDAY @@ -160,15 +164,16 @@ typedef struct { unsigned __int64 base_ticks; unsigned __int64 tick_frequency; FT_t base_systime_as_filetime; + unsigned __int64 reset_time; } my_cxt_t; START_MY_CXT /* Number of 100 nanosecond units from 1/1/1601 to 1/1/1970 */ #ifdef __GNUC__ -#define Const64(x) x##LL +# define Const64(x) x##LL #else -#define Const64(x) x##i64 +# define Const64(x) x##i64 #endif #define EPOCH_BIAS Const64(116444736000000000) @@ -184,8 +189,11 @@ START_MY_CXT /* If the performance counter delta drifts more than 0.5 seconds from the * system time then we recalibrate to the system time. This means we may * move *backwards* in time! */ +#define MAX_PERF_COUNTER_SKEW Const64(5000000) /* 0.5 seconds */ -#define MAX_DIFF Const64(5000000) +/* Reset reading from the performance counter every five minutes. + * Many PC clocks just seem to be so bad. */ +#define MAX_PERF_COUNTER_TICKS Const64(300000000) /* 300 seconds */ static int _gettimeofday(pTHX_ struct timeval *tp, void *not_used) @@ -195,27 +203,28 @@ _gettimeofday(pTHX_ struct timeval *tp, void *not_used) unsigned __int64 ticks; FT_t ft; - if (MY_CXT.run_count++) { + if (MY_CXT.run_count++ == 0 || + MY_CXT.base_systime_as_filetime.ft_i64 > MY_CXT.reset_time) { + QueryPerformanceFrequency((LARGE_INTEGER*)&MY_CXT.tick_frequency); + QueryPerformanceCounter((LARGE_INTEGER*)&MY_CXT.base_ticks); + GetSystemTimeAsFileTime(&MY_CXT.base_systime_as_filetime.ft_val); + ft.ft_i64 = MY_CXT.base_systime_as_filetime.ft_i64; + MY_CXT.reset_time = ft.ft_i64 + MAX_PERF_COUNTER_TICKS; + } + else { __int64 diff; - FT_t filtim; - GetSystemTimeAsFileTime(&filtim.ft_val); QueryPerformanceCounter((LARGE_INTEGER*)&ticks); ticks -= MY_CXT.base_ticks; ft.ft_i64 = MY_CXT.base_systime_as_filetime.ft_i64 + Const64(10000000) * (ticks / MY_CXT.tick_frequency) +(Const64(10000000) * (ticks % MY_CXT.tick_frequency)) / MY_CXT.tick_frequency; diff = ft.ft_i64 - MY_CXT.base_systime_as_filetime.ft_i64; - if (diff < -MAX_DIFF || diff > MAX_DIFF) { - MY_CXT.base_ticks = ticks; - ft.ft_i64 = filtim.ft_i64; + if (diff < -MAX_PERF_COUNTER_SKEW || diff > MAX_PERF_COUNTER_SKEW) { + MY_CXT.base_ticks += ticks; + GetSystemTimeAsFileTime(&MY_CXT.base_systime_as_filetime.ft_val); + ft.ft_i64 = MY_CXT.base_systime_as_filetime.ft_i64; } } - else { - QueryPerformanceFrequency((LARGE_INTEGER*)&MY_CXT.tick_frequency); - QueryPerformanceCounter((LARGE_INTEGER*)&MY_CXT.base_ticks); - GetSystemTimeAsFileTime(&MY_CXT.base_systime_as_filetime.ft_val); - ft.ft_i64 = MY_CXT.base_systime_as_filetime.ft_i64; - } /* seconds since epoch */ tp->tv_sec = (long)((ft.ft_i64 - EPOCH_BIAS) / Const64(10000000)); @@ -702,7 +711,7 @@ static NV myNVtime() { #ifdef WIN32 - dTHX; + dTHX; #endif struct timeval Tp; int status; diff --git a/ext/Time/HiRes/Makefile.PL b/ext/Time/HiRes/Makefile.PL index c48339c..aff9911 100644 --- a/ext/Time/HiRes/Makefile.PL +++ b/ext/Time/HiRes/Makefile.PL @@ -1,8 +1,3 @@ - -# See lib/ExtUtils/MakeMaker.pm for details of how to influence -# the contents of the Makefile that is written. -# - require 5.002; use Config; @@ -16,7 +11,8 @@ my $XSOPT; use vars qw($self); # Used in 'sourcing' the hints. -my $ld_exeext = ($^O eq 'os2' and $Config{ldflags} =~ /-Zexe\b/) ? '.exe' : ''; +my $ld_exeext = ($^O eq 'cygwin' || + $^O eq 'os2' && $Config{ldflags} =~ /-Zexe\b/) ? '.exe' : ''; unless($ENV{PERL_CORE}) { $ENV{PERL_CORE} = 1 if grep { $_ eq 'PERL_CORE=1' } @ARGV; @@ -206,6 +202,23 @@ EOM return 0; } +sub has_include { + my ($inc) = @_; + return 1 if + try_compile_and_link(< +int main _((int argc, char** argv, char** env)) +{ + return 0; +} +EOM + return 0; +} + sub init { my $hints = File::Spec->catfile("hints", "$^O.pl"); if (-f $hints) { @@ -276,7 +289,7 @@ EOD } if ($has_setitimer && $has_getitimer) { - print "You have interval timers (both setitimer and setitimer).\n"; + print "You have interval timers (both setitimer and getitimer).\n"; } else { print "You do not have interval timers.\n"; } @@ -338,11 +351,27 @@ EOD if ($has_nanosleep) { print "found.\n"; - print "You can mix subsecond sleeps with signals.\n"; + print "You can mix subsecond sleeps with signals, if you want to.\n"; + print "(It's still not portable, though.)\n"; } else { print "NOT found.\n"; my $nt = ($^O eq 'os2' ? '' : 'not'); print "You can$nt mix subsecond sleeps with signals.\n"; + print "(It would not be portable anyway.)\n"; + } + + my $has_w32api_windows_h; + if ($^O eq 'cygwin') { + print "Looking for ... "; + if (has_include('w32api/windows.h')) { + $has_w32api_windows_h++; + $DEFINE .= ' -DHAS_W32API_WINDOWS_H'; + } + if ($has_w32api_windows_h) { + print "found.\n"; + } else { + print "NOT found.\n"; + } } if ($DEFINE) { diff --git a/ext/Time/HiRes/hints/solaris.pl b/ext/Time/HiRes/hints/solaris.pl index b19d149..267cf58 100644 --- a/ext/Time/HiRes/hints/solaris.pl +++ b/ext/Time/HiRes/hints/solaris.pl @@ -1,3 +1,9 @@ -# needs to explicitly link against librt to pull in nanosleep -$self->{LIBS} = ['-lrt']; +use POSIX qw(uname); +# 2.6 has nanosleep in -lposix4, after that it's in -lrt +if (substr((uname())[2], 2) <= 6) { + $self->{LIBS} = ['-lposix4']; +} else { + $self->{LIBS} = ['-lrt']; +} + diff --git a/ext/Time/HiRes/t/HiRes.t b/ext/Time/HiRes/t/HiRes.t index 6903970..69be80b 100644 --- a/ext/Time/HiRes/t/HiRes.t +++ b/ext/Time/HiRes/t/HiRes.t @@ -286,7 +286,8 @@ unless ( defined &Time::HiRes::setitimer print "# setitimer: ", join(" ", setitimer(ITIMER_VIRTUAL, 0.5, 0.4)), "\n"; # Assume interval timer granularity of $limit * 0.5 seconds. Too bold? - print "not " unless abs(getitimer(ITIMER_VIRTUAL) / 0.5) - 1 < $limit; + my $virt = getitimer(ITIMER_VIRTUAL); + print "not " unless defined $virt && abs($virt / 0.5) - 1 < $limit; print "ok 18\n"; print "# getitimer: ", join(" ", getitimer(ITIMER_VIRTUAL)), "\n"; @@ -298,7 +299,8 @@ unless ( defined &Time::HiRes::setitimer print "# getitimer: ", join(" ", getitimer(ITIMER_VIRTUAL)), "\n"; - print "not " unless getitimer(ITIMER_VIRTUAL) == 0; + $virt = getitimer(ITIMER_VIRTUAL); + print "not " unless defined $virt && $virt == 0; print "ok 19\n"; $SIG{VTALRM} = 'DEFAULT';