X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FTime%2FHiRes%2FHiRes.xs;h=4c56464065639e94f8593f49ea11c68a14abb06e;hb=ced84e60a279937a6d3baa19b9c0bda889e532f3;hp=436c6142b9f91d11b9afc531bd830dc45a93eb86;hpb=df16a33111ef3b6d66f9b5d4565632665222cbf4;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/Time/HiRes/HiRes.xs b/ext/Time/HiRes/HiRes.xs index 436c614..4c56464 100644 --- a/ext/Time/HiRes/HiRes.xs +++ b/ext/Time/HiRes/HiRes.xs @@ -1,98 +1,55 @@ +/* + * + * Copyright (c) 1996-2002 Douglas E. Wegscheid. All rights reserved. + * + * Copyright (c) 2002,2003,2004,2005 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. + */ + #ifdef __cplusplus extern "C" { #endif +#define PERL_NO_GET_CONTEXT #include "EXTERN.h" #include "perl.h" #include "XSUB.h" +#include "ppport.h" +#if defined(__CYGWIN__) && defined(HAS_W32API_WINDOWS_H) +# include +# define CYGWIN_WITH_W32API +#endif #ifdef WIN32 -#include +# include #else -#include +# include #endif #ifdef HAS_SELECT # ifdef I_SYS_SELECT # include # endif #endif +#if defined(TIME_HIRES_CLOCK_GETTIME_SYSCALL) || defined(TIME_HIRES_CLOCK_GETRES_SYSCALL) +#include +#endif #ifdef __cplusplus } #endif -#ifndef aTHX_ -# define aTHX_ -# define pTHX_ -#endif - -#ifndef NVTYPE -# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) -# define NVTYPE long double -# else -# define NVTYPE double -# endif -typedef NVTYPE NV; -#endif - -#ifndef IVdf -# ifdef IVSIZE -# if IVSIZE == LONGSIZE -# define IVdf "ld" -# define UVuf "lu" -# else -# if IVSIZE == INTSIZE -# define IVdf "d" -# define UVuf "u" -# endif -# endif -# else -# define IVdf "ld" -# define UVuf "lu" -# endif -#endif - -#ifndef NVef -# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \ - defined(PERL_PRIgldbl) /* Not very likely, but let's try anyway. */ -# define NVgf PERL_PRIgldbl -# else -# define NVgf "g" -# endif +#ifndef PerlProc_pause +# define PerlProc_pause() Pause() #endif -#ifndef INT2PTR - -#if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) -# define PTRV UV -# define INT2PTR(any,d) (any)(d) +#ifdef HAS_PAUSE +# define Pause pause #else -# if PTRSIZE == LONGSIZE -# define PTRV unsigned long -# else -# define PTRV unsigned -# endif -# define INT2PTR(any,d) (any)(PTRV)(d) -#endif -#define PTR2IV(p) INT2PTR(IV,p) - -#endif /* !INT2PTR */ - -#ifndef SvPV_nolen -static char * -sv_2pv_nolen(pTHX_ register SV *sv) -{ - STRLEN n_a; - return sv_2pv(sv, &n_a); -} -# define SvPV_nolen(sv) \ - ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ - ? SvPVX(sv) : sv_2pv_nolen(sv)) -#endif - -#ifndef PerlProc_pause -# define PerlProc_pause() Pause() +# undef Pause /* In case perl.h did it already. */ +# define Pause() sleep(~0) /* Zzz for a long time. */ #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) @@ -103,15 +60,18 @@ sv_2pv_nolen(pTHX_ register SV *sv) /* 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" -#if !defined(HAS_GETTIMEOFDAY) && defined(WIN32) -#define HAS_GETTIMEOFDAY +#if defined(WIN32) || defined(CYGWIN_WITH_W32API) + +#ifndef HAS_GETTIMEOFDAY +# define HAS_GETTIMEOFDAY +#endif /* shows up in winsock.h? struct timeval { @@ -125,23 +85,74 @@ 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; + 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) /* 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) + +/* 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 */ + +/* 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) { + 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++ == 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; + 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_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; + } + } /* seconds since epoch */ tp->tv_sec = (long)((ft.ft_i64 - EPOCH_BIAS) / Const64(10000000)); @@ -153,6 +164,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 @@ -340,20 +360,23 @@ gettimeofday (struct timeval *tp, void *tpz) #endif -#if !defined(HAS_USLEEP) && defined(HAS_NANOSLEEP) + /* Do not use H A S _ N A N O S L E E P + * so that Perl Configure doesn't scan for it. + * The TIME_HIRES_NANOSLEEP is set by Makefile.PL. */ +#if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP) #define HAS_USLEEP #define usleep hrt_nanosleep /* could conflict with ncurses for static build */ void -hrt_nanosleep(unsigned long usec) +hrt_nanosleep(unsigned long usec) /* This is used to emulate usleep. */ { struct timespec res; res.tv_sec = usec/1000/1000; res.tv_nsec = ( usec - res.tv_sec*1000*1000 ) * 1000; nanosleep(&res, NULL); } -#endif +#endif /* #if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP) */ #if !defined(HAS_USLEEP) && defined(HAS_SELECT) #ifndef SELECT_IS_BROKEN @@ -370,7 +393,7 @@ hrt_usleep(unsigned long usec) (Select_fd_set_t)NULL, &tv); } #endif -#endif +#endif /* #if !defined(HAS_USLEEP) && defined(HAS_SELECT) */ #if !defined(HAS_USLEEP) && defined(WIN32) #define HAS_USLEEP @@ -383,7 +406,7 @@ hrt_usleep(unsigned long usec) msec = usec / 1000; Sleep (msec); } -#endif +#endif /* #if !defined(HAS_USLEEP) && defined(WIN32) */ #if !defined(HAS_UALARM) && defined(HAS_SETITIMER) @@ -400,7 +423,7 @@ hrt_ualarm(int usec, int interval) itv.it_interval.tv_usec = interval % 1000000; return setitimer(ITIMER_REAL, &itv, 0); } -#endif +#endif /* #if !defined(HAS_UALARM) && defined(HAS_SETITIMER) */ #if !defined(HAS_UALARM) && defined(VMS) #define HAS_UALARM @@ -597,12 +620,12 @@ ualarm_AST(Alarm *a) } } -#endif /* !HAS_UALARM && VMS */ +#endif /* #if !defined(HAS_UALARM) && defined(VMS) */ #ifdef HAS_GETTIMEOFDAY static int -myU2time(UV *ret) +myU2time(pTHX_ UV *ret) { struct timeval Tp; int status; @@ -615,29 +638,44 @@ myU2time(UV *ret) static NV myNVtime() { +#ifdef WIN32 + dTHX; +#endif struct timeval Tp; int status; status = gettimeofday (&Tp, NULL); return status == 0 ? Tp.tv_sec + (Tp.tv_usec / 1000000.) : -1.0; } -#endif +#endif /* #ifdef HAS_GETTIMEOFDAY */ 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); -} + { + hv_store(PL_modglobal, "Time::NVtime", 12, newSViv(PTR2IV(myNVtime)), 0); + hv_store(PL_modglobal, "Time::U2time", 12, newSViv(PTR2IV(myU2time)), 0); + } #endif #endif +} + +#if defined(USE_ITHREADS) && defined(MY_CXT_KEY) + +void +CLONE(...) + CODE: + MY_CXT_CLONE; + +#endif INCLUDE: const-xs.inc @@ -674,6 +712,47 @@ usleep(useconds) OUTPUT: RETVAL +#if defined(TIME_HIRES_NANOSLEEP) + +NV +nanosleep(nseconds) + NV nseconds + PREINIT: + struct timeval Ta, Tb; + CODE: + gettimeofday(&Ta, NULL); + if (items > 0) { + struct timespec tsa; + if (nseconds > 1E9) { + IV seconds = (IV) (nseconds / 1E9); + if (seconds) { + sleep(seconds); + nseconds -= 1E9 * seconds; + } + } else if (nseconds < 0.0) + croak("Time::HiRes::nanosleep(%"NVgf"): negative time not invented yet", nseconds); + tsa.tv_sec = (IV) (nseconds / 1E9); + tsa.tv_nsec = (IV) nseconds - tsa.tv_sec * 1E9; + nanosleep(&tsa, NULL); + } else + PerlProc_pause(); + gettimeofday(&Tb, NULL); + RETVAL = 1E3*(1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec)); + + OUTPUT: + RETVAL + +#else /* #if defined(TIME_HIRES_NANOSLEEP) */ + +NV +nanosleep(nseconds) + NV nseconds + CODE: + croak("Time::HiRes::nanosleep(): unimplemented in this platform"); + RETVAL = 0.0; + +#endif /* #if defined(TIME_HIRES_NANOSLEEP) */ + NV sleep(...) PREINIT: @@ -693,7 +772,7 @@ sleep(...) * circumstances (if the double is cast to UV more * than once?) evaluate to -0.5, instead of 0.5. */ useconds = -(IV)useconds; -#endif +#endif /* #if defined(__sparc64__) && defined(__GNUC__) */ if ((IV)useconds < 0) croak("Time::HiRes::sleep(%"NVgf"): internal error: useconds < 0 (unsigned %"UVuf" signed %"IVdf")", seconds, useconds, (IV)useconds); } @@ -711,7 +790,16 @@ sleep(...) OUTPUT: RETVAL -#endif +#else /* #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) */ + +NV +usleep(useconds) + NV useconds + CODE: + croak("Time::HiRes::usleep(): unimplemented in this platform"); + RETVAL = 0.0; + +#endif /* #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) */ #ifdef HAS_UALARM @@ -740,7 +828,25 @@ alarm(seconds,interval=0) OUTPUT: RETVAL -#endif +#else + +int +ualarm(useconds,interval=0) + int useconds + int interval + CODE: + croak("Time::HiRes::ualarm(): unimplemented in this platform"); + RETVAL = -1; + +NV +alarm(seconds,interval=0) + NV seconds + NV interval + CODE: + croak("Time::HiRes::alarm(): unimplemented in this platform"); + RETVAL = 0.0; + +#endif /* #ifdef HAS_UALARM */ #ifdef HAS_GETTIMEOFDAY # ifdef MACOS_TRADITIONAL /* fix epoch TZ and use unsigned time_t */ @@ -752,16 +858,18 @@ gettimeofday() PPCODE: int status; status = gettimeofday (&Tp, &Tz); - Tp.tv_sec += Tz.tz_minuteswest * 60; /* adjust for TZ */ - if (GIMME == G_ARRAY) { - EXTEND(sp, 2); - /* Mac OS (Classic) has unsigned time_t */ - PUSHs(sv_2mortal(newSVuv(Tp.tv_sec))); - PUSHs(sv_2mortal(newSViv(Tp.tv_usec))); - } else { - EXTEND(sp, 1); - PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec / 1000000.0)))); + if (status == 0) { + Tp.tv_sec += Tz.tz_minuteswest * 60; /* adjust for TZ */ + if (GIMME == G_ARRAY) { + EXTEND(sp, 2); + /* Mac OS (Classic) has unsigned time_t */ + PUSHs(sv_2mortal(newSVuv(Tp.tv_sec))); + PUSHs(sv_2mortal(newSViv(Tp.tv_usec))); + } else { + EXTEND(sp, 1); + PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec / 1000000.0)))); + } } NV @@ -772,8 +880,12 @@ time() CODE: int status; status = gettimeofday (&Tp, &Tz); - Tp.tv_sec += Tz.tz_minuteswest * 60; /* adjust for TZ */ - RETVAL = Tp.tv_sec + (Tp.tv_usec / 1000000.0); + if (status == 0) { + Tp.tv_sec += Tz.tz_minuteswest * 60; /* adjust for TZ */ + RETVAL = Tp.tv_sec + (Tp.tv_usec / 1000000.0); + } else { + RETVAL = -1.0; + } OUTPUT: RETVAL @@ -785,13 +897,15 @@ gettimeofday() PPCODE: int status; status = gettimeofday (&Tp, NULL); - if (GIMME == G_ARRAY) { - EXTEND(sp, 2); - PUSHs(sv_2mortal(newSViv(Tp.tv_sec))); - PUSHs(sv_2mortal(newSViv(Tp.tv_usec))); - } else { - EXTEND(sp, 1); - PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec / 1000000.0)))); + if (status == 0) { + if (GIMME == G_ARRAY) { + EXTEND(sp, 2); + PUSHs(sv_2mortal(newSViv(Tp.tv_sec))); + PUSHs(sv_2mortal(newSViv(Tp.tv_usec))); + } else { + EXTEND(sp, 1); + PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec / 1000000.0)))); + } } NV @@ -801,12 +915,16 @@ time() CODE: int status; status = gettimeofday (&Tp, NULL); - RETVAL = Tp.tv_sec + (Tp.tv_usec / 1000000.); + if (status == 0) { + RETVAL = Tp.tv_sec + (Tp.tv_usec / 1000000.); + } else { + RETVAL = -1.0; + } OUTPUT: RETVAL # endif /* MACOS_TRADITIONAL */ -#endif +#endif /* #ifdef HAS_GETTIMEOFDAY */ #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER) @@ -853,5 +971,65 @@ getitimer(which) } } +#endif /* #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER) */ + +#if defined(TIME_HIRES_CLOCK_GETTIME) + +NV +clock_gettime(clock_id = CLOCK_REALTIME) + int clock_id + PREINIT: + struct timespec ts; + int status = -1; + CODE: +#ifdef TIME_HIRES_CLOCK_GETTIME_SYSCALL + status = syscall(SYS_clock_gettime, clock_id, &ts); +#else + status = clock_gettime(clock_id, &ts); #endif + RETVAL = status == 0 ? ts.tv_sec + (NV) ts.tv_nsec / (NV) 1e9 : -1; + + OUTPUT: + RETVAL + +#else /* if defined(TIME_HIRES_CLOCK_GETTIME) */ + +NV +clock_gettime(clock_id = 0) + int clock_id + CODE: + croak("Time::HiRes::clock_gettime(): unimplemented in this platform"); + RETVAL = 0.0; + +#endif /* #if defined(TIME_HIRES_CLOCK_GETTIME) */ + +#if defined(TIME_HIRES_CLOCK_GETRES) + +NV +clock_getres(clock_id = CLOCK_REALTIME) + int clock_id + PREINIT: + int status = -1; + struct timespec ts; + CODE: +#ifdef TIME_HIRES_CLOCK_GETRES_SYSCALL + status = syscall(SYS_clock_getres, clock_id, &ts); +#else + status = clock_getres(clock_id, &ts); +#endif + RETVAL = status == 0 ? ts.tv_sec + (NV) ts.tv_nsec / (NV) 1e9 : -1; + + OUTPUT: + RETVAL + +#else /* if defined(TIME_HIRES_CLOCK_GETRES) */ + +NV +clock_getres(clock_id = 0) + int clock_id + CODE: + croak("Time::HiRes::clock_getres(): unimplemented in this platform"); + RETVAL = 0.0; + +#endif /* #if defined(TIME_HIRES_CLOCK_GETRES) */