Upgrade to Time::HiRes 1.54

p4raw-id: //depot/perl@22051

diff --git a/MANIFEST b/MANIFEST
index d2543db..b2ea90a 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -749,6 +749,7 @@ ext/Time/HiRes/hints/dec_osf.pl             Hint for Time::HiRes for named architecture
 ext/Time/HiRes/hints/dynixptx.pl       Hint for Time::HiRes for named architecture
 ext/Time/HiRes/hints/irix.pl   Hint for Time::HiRes for named architecture
 ext/Time/HiRes/hints/sco.pl    Hints for Time::HiRes for named architecture
+ext/Time/HiRes/hints/solaris.pl        Hints for Time::HiRes for named architecture
 ext/Time/HiRes/hints/svr4.pl   Hints for Time::HiRes for named architecture
 ext/Time/HiRes/HiRes.pm                Time::HiRes extension
 ext/Time/HiRes/HiRes.xs                Time::HiRes extension

diff --git a/ext/Time/HiRes/Changes b/ext/Time/HiRes/Changes
index c2bce39..e5fbe83 100644 (file)
--- a/ext/Time/HiRes/Changes
+++ b/ext/Time/HiRes/Changes
@@ -1,5 +1,15 @@
 Revision history for Perl extension Time::HiRes.
 
+1.54
+       - Solaris: like Tru64 (dec_osf) also Solaris need -lrt for nanosleep
+
+1.53
+       - Windows: higher resolution time() by using the Windows
+         performance counter API, from Jan Dubois and Anton Shcherbinin.
+         The exact new higher resolution depends on the hardware,
+         but it should be quite a bit better than using the basic
+         Windows timers.
+
 1.52
        - In AIX (v?) with perl 5.6.1 the HiRes.t can hang after
          the subtest 18.  No known analysis nor fix, but added

diff --git a/ext/Time/HiRes/HiRes.pm b/ext/Time/HiRes/HiRes.pm
index d04b1a8..72eed1c 100644 (file)
--- 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.52';
+$VERSION = '1.54';
 $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -343,7 +343,7 @@ G. Aas <gisle@aas.no>
 
 Copyright (c) 1996-2002 Douglas E. Wegscheid.  All rights reserved.
 
-Copyright (c) 2002,2003 Jarkko Hietaniemi.  All rights reserved.
+Copyright (c) 2002,2003,2004 Jarkko Hietaniemi.  All rights reserved.
 
 This program is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself.

diff --git a/ext/Time/HiRes/HiRes.xs b/ext/Time/HiRes/HiRes.xs
index 91249f0..2765983 100644 (file)
--- a/ext/Time/HiRes/HiRes.xs
+++ b/ext/Time/HiRes/HiRes.xs
@@ -1,6 +1,7 @@
 #ifdef __cplusplus
 extern "C" {
 #endif
+#define PERL_NO_GET_CONTEXT
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
@@ -18,10 +19,34 @@ extern "C" {
 }
 #endif
 
+#ifndef NOOP
+#    define NOOP (void)0
+#endif
+#ifndef dNOOP
+#    define dNOOP extern int Perl___notused
+#endif
+
 #ifndef aTHX_
 #    define aTHX_
 #    define pTHX_
-#endif         
+#    define dTHX dNOOP
+#endif
+
+#ifdef START_MY_CXT
+#  ifndef MY_CXT_CLONE
+#    define MY_CXT_CLONE                                                \
+       dMY_CXT_SV;                                                     \
+       my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
+       Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t); \
+       sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
+#  endif
+#else
+#    define START_MY_CXT static my_cxt_t my_cxt;
+#    define dMY_CXT     dNOOP
+#    define MY_CXT_INIT         NOOP
+#    define MY_CXT_CLONE NOOP
+#    define MY_CXT      my_cxt
+#endif
 
 #ifndef NVTYPE
 #   if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
@@ -110,8 +135,11 @@ sv_2pv_nolen(pTHX_ register SV *sv)
 
 #include "const-c.inc"
 
-#if !defined(HAS_GETTIMEOFDAY) && defined(WIN32)
-#define HAS_GETTIMEOFDAY
+#ifdef WIN32
+
+#ifndef HAS_GETTIMEOFDAY
+#   define HAS_GETTIMEOFDAY
+#endif
 
 /* shows up in winsock.h?
 struct timeval {
@@ -125,6 +153,17 @@ typedef union {
     FILETIME           ft_val;
 } FT_t;
 
+#define MY_CXT_KEY "Time::HiRes_" XS_VERSION
+
+typedef struct {
+    unsigned long run_count;
+    unsigned __int64 base_ticks;
+    unsigned __int64 tick_frequency;
+    FT_t base_systime_as_filetime;
+} 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
@@ -135,13 +174,34 @@ typedef union {
 
 /* NOTE: This does not compute the timezone info (doing so can be expensive,
  * and appears to be unsupported even by glibc) */
-int
-gettimeofday (struct timeval *tp, void *not_used)
+
+/* dMY_CXT needs a Perl context and we don't want to call PERL_GET_CONTEXT
+   for performance reasons */
+
+#undef gettimeofday
+#define gettimeofday(tp, not_used) _gettimeofday(aTHX_ tp, not_used)
+
+static int
+_gettimeofday(pTHX_ struct timeval *tp, void *not_used)
 {
+    dMY_CXT;
+
+    unsigned __int64 ticks;
     FT_t ft;
 
-    /* this returns time in 100-nanosecond units  (i.e. tens of usecs) */
-    GetSystemTimeAsFileTime(&ft.ft_val);
+    if (MY_CXT.run_count++) {
+        QueryPerformanceCounter((LARGE_INTEGER*)&ticks);
+        ticks -= MY_CXT.base_ticks;
+        ft.ft_i64 = MY_CXT.base_systime_as_filetime.ft_i64
+                    + 10000000i64 * (ticks / MY_CXT.tick_frequency)
+                    +(10000000i64 * (ticks % MY_CXT.tick_frequency)) / MY_CXT.tick_frequency;
+    }
+    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));
@@ -153,6 +213,15 @@ gettimeofday (struct timeval *tp, void *not_used)
 }
 #endif
 
+#if defined(WIN32) && !defined(ATLEASTFIVEOHOHFIVE)
+static unsigned int
+sleep(unsigned int t)
+{
+    Sleep(t*1000);
+    return 0;
+}
+#endif
+
 #if !defined(HAS_GETTIMEOFDAY) && defined(VMS)
 #define HAS_GETTIMEOFDAY
 
@@ -605,7 +674,7 @@ ualarm_AST(Alarm *a)
 #ifdef HAS_GETTIMEOFDAY
 
 static int
-myU2time(UV *ret)
+myU2time(pTHX_ UV *ret)
 {
   struct timeval Tp;
   int status;
@@ -618,6 +687,9 @@ myU2time(UV *ret)
 static NV
 myNVtime()
 {
+#ifdef WIN32
+    dTHX;
+#endif
   struct timeval Tp;
   int status;
   status = gettimeofday (&Tp, NULL);
@@ -631,15 +703,29 @@ MODULE = Time::HiRes            PACKAGE = Time::HiRes
 PROTOTYPES: ENABLE
 
 BOOT:
+{
+#ifdef MY_CXT_KEY
+  MY_CXT_INIT;
+#endif
 #ifdef ATLEASTFIVEOHOHFIVE
 #ifdef HAS_GETTIMEOFDAY
-{
-  UV auv[2];
-  hv_store(PL_modglobal, "Time::NVtime", 12, newSViv(PTR2IV(myNVtime)), 0);
-  if (myU2time(auv) == 0)
-    hv_store(PL_modglobal, "Time::U2time", 12, newSViv((IV) auv[0]), 0);
-}
+  {
+    UV auv[2];
+    hv_store(PL_modglobal, "Time::NVtime", 12, newSViv(PTR2IV(myNVtime)), 0);
+    if (myU2time(aTHX_ auv) == 0)
+      hv_store(PL_modglobal, "Time::U2time", 12, newSViv((IV) auv[0]), 0);
+  }
+#endif
 #endif
+}
+
+#if defined(USE_ITHREADS) && defined(MY_CXT_KEY)
+
+void
+CLONE(...)
+    CODE:
+    MY_CXT_CLONE;
+
 #endif
 
 INCLUDE: const-xs.inc

diff --git a/ext/Time/HiRes/hints/solaris.pl b/ext/Time/HiRes/hints/solaris.pl
new file mode 100644 (file)
index 0000000..b19d149
--- /dev/null
+++ b/ext/Time/HiRes/hints/solaris.pl
@@ -0,0 +1,3 @@
+# needs to explicitly link against librt to pull in nanosleep
+$self->{LIBS} = ['-lrt'];
+