[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