summaryrefslogtreecommitdiff
path: root/ext/Time
diff options
context:
space:
mode:
authorRafael Garcia-Suarez <rgarciasuarez@gmail.com>2004-01-03 19:51:02 +0000
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>2004-01-03 19:51:02 +0000
commit0225372c57036b54771b8abce5d6355b7e7ed288 (patch)
treeb3da6f0393911b081e57ae1c39b1811a5463dab7 /ext/Time
parent7224c650f2c20f798575fdf9ecc82fe277635a86 (diff)
downloadperl-0225372c57036b54771b8abce5d6355b7e7ed288.tar.gz
Upgrade to Time::HiRes 1.54
p4raw-id: //depot/perl@22051
Diffstat (limited to 'ext/Time')
-rw-r--r--ext/Time/HiRes/Changes10
-rw-r--r--ext/Time/HiRes/HiRes.pm4
-rw-r--r--ext/Time/HiRes/HiRes.xs114
-rw-r--r--ext/Time/HiRes/hints/solaris.pl3
4 files changed, 115 insertions, 16 deletions
diff --git a/ext/Time/HiRes/Changes b/ext/Time/HiRes/Changes
index c2bce390a2..e5fbe837ff 100644
--- 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 d04b1a895b..72eed1c4a5 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.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 91249f0fd2..2765983bf6 100644
--- 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
index 0000000000..b19d149e70
--- /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'];
+