[Orca-checkins] r383 - in trunk/orca: . packages/Time-HiRes-1.59 packages/Time-HiRes-1.61 packages/Time-HiRes-1.61/hints packages/Time-HiRes-1.61/t

Blair Zajac blair at orcaware.com
Sat Aug 21 12:27:06 PDT 2004


Author: blair
Date: Sat Aug 21 12:25:13 2004
New Revision: 383

Added:
   trunk/orca/packages/Time-HiRes-1.61/
      - copied from r382, trunk/orca/packages/Time-HiRes-1.59/
Removed:
   trunk/orca/packages/Time-HiRes-1.59/
Modified:
   trunk/orca/INSTALL
   trunk/orca/configure.in
   trunk/orca/packages/Time-HiRes-1.61/Changes
   trunk/orca/packages/Time-HiRes-1.61/HiRes.pm
   trunk/orca/packages/Time-HiRes-1.61/HiRes.xs
   trunk/orca/packages/Time-HiRes-1.61/META.yml
   trunk/orca/packages/Time-HiRes-1.61/Makefile.PL
   trunk/orca/packages/Time-HiRes-1.61/hints/solaris.pl
   trunk/orca/packages/Time-HiRes-1.61/t/HiRes.t
Log:
Upgrade Time::HiRes from 1.59 to 1.61.

* INSTALL (Determine which Perl modules need compiling and installing):
  Update all references to Time::HiRes's version number from 1.59 to
  1.61.

* configure.in:
  Bump Time::HiRes's version number to 1.61.

* packages/Time-HiRes-1.61:
  Renamed from packages/Time-HiRes-1.59.  Directory contents updated
  from Time-HiRes-1.61.tar.gz.


Modified: trunk/orca/INSTALL
==============================================================================
--- trunk/orca/INSTALL	(original)
+++ trunk/orca/INSTALL	Sat Aug 21 12:25:13 2004
@@ -177,7 +177,7 @@
     Math::IntervalSearch    >= 1.05        >= 1.05      1.05
     RRDs                    >= 1.000491    >= 1.0.49    1.0.49
     Storable                >= 2.13        >= 2.13      2.13
-    Time::HiRes             Not required by Orca        1.59
+    Time::HiRes             Not required by Orca        1.61
     version                 >= 0.42        >= 0.42      0.42
 
     All seven of these modules are included with the Orca distribution
@@ -279,10 +279,10 @@
 
     Time::HiRes
 
-      http://www.perl.com/CPAN/authors/id/J/JH/JHI/Time-HiRes-1.59.tar.gz
+      http://www.perl.com/CPAN/authors/id/J/JH/JHI/Time-HiRes-1.61.tar.gz
 
-      % gunzip -c Time-HiRes-1.59.tar.gz | tar xvf -
-      % cd Time-HiRes-1.59
+      % gunzip -c Time-HiRes-1.61.tar.gz | tar xvf -
+      % cd Time-HiRes-1.61
       % perl Makefile.PL
       % make
       % make test

Modified: trunk/orca/configure.in
==============================================================================
--- trunk/orca/configure.in	(original)
+++ trunk/orca/configure.in	Sat Aug 21 12:25:13 2004
@@ -41,8 +41,8 @@
 RRDTOOL_VER=1.000491
 STORABLE_DIR=Storable-2.13
 STORABLE_VER=2.13
-TIME_HIRES_DIR=Time-HiRes-1.59
-TIME_HIRES_VER=1.59
+TIME_HIRES_DIR=Time-HiRes-1.61
+TIME_HIRES_VER=1.61
 VERSION_DIR=version-0.42
 VERSION_VER=0.42
 

Modified: trunk/orca/packages/Time-HiRes-1.61/Changes
==============================================================================
--- trunk/orca/packages/Time-HiRes-1.59/Changes	(original)
+++ trunk/orca/packages/Time-HiRes-1.61/Changes	Sat Aug 21 12:25:13 2004
@@ -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 @@
 	  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

Modified: trunk/orca/packages/Time-HiRes-1.61/HiRes.pm
==============================================================================
--- trunk/orca/packages/Time-HiRes-1.59/HiRes.pm	(original)
+++ trunk/orca/packages/Time-HiRes-1.61/HiRes.pm	Sat Aug 21 12:25:13 2004
@@ -15,7 +15,7 @@
 		 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 @@
 
 =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 @@
 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 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).

Modified: trunk/orca/packages/Time-HiRes-1.61/HiRes.xs
==============================================================================
--- trunk/orca/packages/Time-HiRes-1.59/HiRes.xs	(original)
+++ trunk/orca/packages/Time-HiRes-1.61/HiRes.xs	Sat Aug 21 12:25:13 2004
@@ -5,10 +5,14 @@
 #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 @@
 #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 @@
 
 /* 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 @@
     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 @@
 /* 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 @@
     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 @@
 myNVtime()
 {
 #ifdef WIN32
-    dTHX;
+  dTHX;
 #endif
   struct timeval Tp;
   int status;

Modified: trunk/orca/packages/Time-HiRes-1.61/META.yml
==============================================================================
--- trunk/orca/packages/Time-HiRes-1.59/META.yml	(original)
+++ trunk/orca/packages/Time-HiRes-1.61/META.yml	Sat Aug 21 12:25:13 2004
@@ -1,7 +1,7 @@
 # http://module-build.sourceforge.net/META-spec.html
 #XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
 name:         Time-HiRes
-version:      1.59
+version:      1.61
 version_from: HiRes.pm
 installdirs:  perl
 requires:

Modified: trunk/orca/packages/Time-HiRes-1.61/Makefile.PL
==============================================================================
--- trunk/orca/packages/Time-HiRes-1.59/Makefile.PL	(original)
+++ trunk/orca/packages/Time-HiRes-1.61/Makefile.PL	Sat Aug 21 12:25:13 2004
@@ -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 @@
 
 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 @@
     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 @@
     }
 
     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 @@
 
     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) {

Modified: trunk/orca/packages/Time-HiRes-1.61/hints/solaris.pl
==============================================================================
--- trunk/orca/packages/Time-HiRes-1.59/hints/solaris.pl	(original)
+++ trunk/orca/packages/Time-HiRes-1.61/hints/solaris.pl	Sat Aug 21 12:25:13 2004
@@ -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'];
+}
+
 

Modified: trunk/orca/packages/Time-HiRes-1.61/t/HiRes.t
==============================================================================
--- trunk/orca/packages/Time-HiRes-1.59/t/HiRes.t	(original)
+++ trunk/orca/packages/Time-HiRes-1.61/t/HiRes.t	Sat Aug 21 12:25:13 2004
@@ -286,7 +286,8 @@
     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 @@
 
     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';



More information about the Orca-checkins mailing list