This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Time::HiRes 1.61
authorRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Sun, 22 Aug 2004 19:14:57 +0000 (19:14 +0000)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Sun, 22 Aug 2004 19:14:57 +0000 (19:14 +0000)
p4raw-id: //depot/perl@23232

ext/Time/HiRes/Changes
ext/Time/HiRes/HiRes.pm
ext/Time/HiRes/HiRes.xs
ext/Time/HiRes/Makefile.PL
ext/Time/HiRes/hints/solaris.pl
ext/Time/HiRes/t/HiRes.t

index 7b64ee1..3dd17ae 100644 (file)
@@ -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
+         <w32api/windows.h> 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
index 98d3142..8dc4a19 100644 (file)
@@ -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<Time::HiRes> module implements a Perl interface to the C<usleep>,
-C<ualarm>, C<gettimeofday>, and C<setitimer>/C<getitimer> system calls, in other
-words, high resolution time and timers. See the L</EXAMPLES> section below
-and the test scripts for usage; see your system documentation for the
-description of the underlying C<nanosleep> or C<usleep>, C<ualarm>,
-C<gettimeofday>, and C<setitimer>/C<getitimer> calls.
+The C<Time::HiRes> module implements a Perl interface to the
+C<usleep>, C<ualarm>, C<gettimeofday>, and C<setitimer>/C<getitimer>
+system calls, in other words, high resolution time and timers. See the
+L</EXAMPLES> section below and the test scripts for usage; see your
+system documentation for the description of the underlying
+C<nanosleep> or C<usleep>, C<ualarm>, C<gettimeofday>, and
+C<setitimer>/C<getitimer> calls.
 
 If your system lacks C<gettimeofday()> or an emulation of it you don't
-get C<gettimeofday()> or the one-argument form of C<tv_interval()>.  If your system lacks all of 
-C<nanosleep()>, C<usleep()>, and C<select()>, you don't get
-C<Time::HiRes::usleep()> or C<Time::HiRes::sleep()>.  If your system lacks both
-C<ualarm()> and C<setitimer()> you don't get
-C<Time::HiRes::ualarm()> or C<Time::HiRes::alarm()>.
+get C<gettimeofday()> or the one-argument form of C<tv_interval()>.
+If your system lacks all of C<nanosleep()>, C<usleep()>, and
+C<select()>, you don't get C<Time::HiRes::usleep()> or
+C<Time::HiRes::sleep()>.  If your system lacks both C<ualarm()> and
+C<setitimer()> you don't get C<Time::HiRes::ualarm()> or
+C<Time::HiRes::alarm()>.
 
 If you try to import an unimplemented function in the C<use> statement
 it will fail at compile time.
 
-If your subsecond sleeping is implemented with C<nanosleep()> instead of
-C<usleep()>, you can mix subsecond sleeping with signals since
-C<nanosleep()> 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<nanosleep()> C API documentation for any peculiarities.  (There is no
-separate interface to call C<nanosleep()>; just use C<Time::HiRes::sleep()>
-or C<Time::HiRes::usleep()> with small enough values.)
+If your subsecond sleeping is implemented with C<nanosleep()> instead
+of C<usleep()>, you can mix subsecond sleeping with signals since
+C<nanosleep()> 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<nanosleep()> C API documentation for any
+peculiarities.  (There is no separate interface to call
+C<nanosleep()>; just use C<Time::HiRes::sleep()> or
+C<Time::HiRes::usleep()> with small enough values.)
 
 Unless using C<nanosleep> 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<NOTE 2>: Since Sunday, September 9th, 2001 at 01:46:40 AM GMT, when
 the C<time()> 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<Time::HiRes::time()> 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<printf>/C<sprintf> with C<"%.6f">, or the C<gettimeofday()> function in
-list context, which will give you the seconds and microseconds as two
-separate values.
+C<Time::HiRes::time()> 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<printf>/C<sprintf> with C<"%.6f">, or the
+C<gettimeofday()> 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<ITIMER_REAL>, C<ITIMER_VIRTUAL>, C<ITIMER_PROF>, or C<ITIMER_REALPROF>.
-Note that which ones are available depends: true UNIX platforms usually
-have the first three, but (for example) Win32 and Cygwin have only
-C<ITIMER_REAL>, and only Solaris seems to have C<ITIMER_REALPROF> (which is
-used to profile multithreaded programs).
+There are usually three or four interval timers available: the
+C<$which> can be C<ITIMER_REAL>, C<ITIMER_VIRTUAL>, C<ITIMER_PROF>, or
+C<ITIMER_REALPROF>.  Note that which ones are available depends: true
+UNIX platforms usually have the first three, but (for example) Win32
+and Cygwin have only C<ITIMER_REAL>, and only Solaris seems to have
+C<ITIMER_REALPROF> (which is used to profile multithreaded programs).
 
 C<ITIMER_REAL> results in C<alarm()>-like behavior.  Time is counted in
 I<real time>; that is, wallclock time.  C<SIGALRM> is delivered when
 the timer expires.
 
-C<ITIMER_VIRTUAL> counts time in (process) I<virtual time>; 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<user time>.)  C<SIGVTALRM> is delivered when the timer expires.
+C<ITIMER_VIRTUAL> counts time in (process) I<virtual time>; 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<user time>.)  C<SIGVTALRM> is delivered when the
+timer expires.
 
 C<ITIMER_PROF> counts time when either the process virtual time or when
 the operating system is running on behalf of the process (such as I/O).
index 3505bf4..380077a 100644 (file)
@@ -5,10 +5,14 @@ extern "C" {
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
+#if defined(__CYGWIN__) && defined(HAS_W32API_WINDOWS_H)
+# include <w32api/windows.h>
+# define CYGWIN_WITH_W32API
+#endif
 #ifdef WIN32
-#include <time.h>
+# include <time.h>
 #else
-#include <sys/time.h>
+# include <sys/time.h>
 #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;
index c48339c..aff9911 100644 (file)
@@ -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(<<EOM);
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include <$inc>
+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 <w32api/windows.h>... ";
+        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) {
index b19d149..267cf58 100644 (file)
@@ -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'];
+}
+
 
index 6903970..69be80b 100644 (file)
@@ -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';