From: Rafael Garcia-Suarez Date: Sat, 3 Jan 2004 19:51:02 +0000 (+0000) Subject: Upgrade to Time::HiRes 1.54 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0225372c57036b54771b8abce5d6355b7e7ed288;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Time::HiRes 1.54 p4raw-id: //depot/perl@22051 --- diff --git a/MANIFEST b/MANIFEST index d2543db..b2ea90a 100644 --- 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 --- 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 --- 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 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 --- 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 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']; +