diff --git a/dist/Time-HiRes/HiRes.pm b/dist/Time-HiRes/HiRes.pm index 69436376f1da..c4b493af0052 100644 --- a/dist/Time-HiRes/HiRes.pm +++ b/dist/Time-HiRes/HiRes.pm @@ -9,48 +9,11 @@ use XSLoader (); our @ISA = qw(Exporter); our @EXPORT = qw( ); -# More or less this same list is in Makefile.PL. Should unify. -our @EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval - getitimer setitimer nanosleep clock_gettime clock_getres - clock clock_nanosleep - CLOCKS_PER_SEC - CLOCK_BOOTTIME - CLOCK_HIGHRES - CLOCK_MONOTONIC - CLOCK_MONOTONIC_COARSE - CLOCK_MONOTONIC_FAST - CLOCK_MONOTONIC_PRECISE - CLOCK_MONOTONIC_RAW - CLOCK_PROCESS_CPUTIME_ID - CLOCK_PROF - CLOCK_REALTIME - CLOCK_REALTIME_COARSE - CLOCK_REALTIME_FAST - CLOCK_REALTIME_PRECISE - CLOCK_REALTIME_RAW - CLOCK_SECOND - CLOCK_SOFTTIME - CLOCK_THREAD_CPUTIME_ID - CLOCK_TIMEOFDAY - CLOCK_UPTIME - CLOCK_UPTIME_COARSE - CLOCK_UPTIME_FAST - CLOCK_UPTIME_PRECISE - CLOCK_UPTIME_RAW - CLOCK_VIRTUAL - ITIMER_PROF - ITIMER_REAL - ITIMER_REALPROF - ITIMER_VIRTUAL - TIMER_ABSTIME - d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer - d_nanosleep d_clock_gettime d_clock_getres - d_clock d_clock_nanosleep d_hires_stat - d_futimens d_utimensat d_hires_utime - stat lstat utime - ); - -our $VERSION = '1.9778'; +# More or less this same list is in Makefile.PL. Should unify. It is filled +# in by ::bootstrap(). Check t/clock.t for the definition. +our @EXPORT_OK; + +our $VERSION = '1.9779'; our $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -90,7 +53,7 @@ sub import { goto &Exporter::import; } -XSLoader::load( 'Time::HiRes', $XS_VERSION ); +XSLoader::load( 'Time::HiRes', $XS_VERSION, \@EXPORT_OK ); # Preloaded methods go here. diff --git a/dist/Time-HiRes/HiRes.xs b/dist/Time-HiRes/HiRes.xs index b879198a30a2..af4e09f51b94 100644 --- a/dist/Time-HiRes/HiRes.xs +++ b/dist/Time-HiRes/HiRes.xs @@ -55,11 +55,136 @@ # define GCC_DIAG_IGNORE_CPP_COMPAT_RESTORE_STMT GCC_DIAG_RESTORE_STMT #endif +#ifndef PERL_STATIC_FORCE_INLINE +# define PERL_STATIC_FORCE_INLINE STATIC +#endif + #if PERL_VERSION_GE(5,7,3) && !PERL_VERSION_GE(5,10,1) # undef SAVEOP # define SAVEOP() SAVEVPTR(PL_op) #endif +#if defined(SV_COW_SHARED_HASH_KEYS) && defined(SV_COW_OTHER_PVS) +# define THR_newSVsv_cow(sv) newSVsv_flags((sv), SV_GMAGIC|SV_NOSTEAL|SV_COW_SHARED_HASH_KEYS|SV_COW_OTHER_PVS) +#elif defined(SV_COW_SHARED_HASH_KEYS) +# define THR_newSVsv_cow(sv) newSVsv_flags((sv), SV_GMAGIC|SV_NOSTEAL|SV_COW_SHARED_HASH_KEYS) +#elif defined(SV_COW_OTHER_PVS) +# define THR_newSVsv_cow(sv) newSVsv_flags((sv), SV_GMAGIC|SV_NOSTEAL|SV_COW_OTHER_PVS) +#else +# define THR_newSVsv_cow(sv) newSVsv_flags((sv), SV_GMAGIC|SV_NOSTEAL) +#endif + +/* PL_op->op_private & OPpENTERSUB_HASTARG feature was added in + +d30110745a - Ilya Zakharevich -8/26/1999 11:33:01 PM - 5.5.61 +Speeding up XSUB calls up to 66% +Addendum: it's "only" 33% speedup. + + These 3 are highly optimized version of 3 macros from pp.h that were + purpose made mostly for EU::PXS's private use, but we DO NOT want to execute + a slower sv_newmortal() + sv_set_i_u_n_v_mg(), instead of + sv_2mortal(newSV_i_u_n_v()). + + These macros do not put the new SV* on the stack. Caller is responsible for + that. + + Arg _nsv is an uninitialized SV* variable, a new SV* will be placed in + the _nsv var. SvREFCNT()/SV* lifecycle details are handled by the macro. + The caller IS NOT allowed to execute a "sv_2mortal(_nsv);" on the new SV*. + + sv_set_i_u_n_v_mg() is required to a huge amount of safety checks like + de-COW PVs RVs, COWs, sv_upgrade(), copy old SV body contents to a higher + order SV body, etc. + + Also if G_LIST context, we do not want Perl_leave_adjust_stacks() to create + a mortal copy of our PAD SV* TARG. Example of returning a dXSTARG, and + Perl_leave_adjust_stacks() instantly makes a mortal dup of it is this code + $self->logtime(time()); +*/ + + + +/* set TARG to the IV value i. If do_taint is false, + * assume that PL_tainted can never be true */ +#define TMR_TARGi(_nsv, i, do_taint) \ +STMT_START { \ + IV TARGi_iv = i; \ + if (GIMME_V == G_LIST || !(PL_op->op_private & OPpENTERSUB_HASTARG)) \ + _nsv = sv_2mortal(newSViv(TARGi_iv)); \ + else { \ + _nsv = PAD_SV(PL_op->op_targ); \ + if (LIKELY( \ + ((SvFLAGS(_nsv) & (SVTYPEMASK|SVf_THINKFIRST|SVf_IVisUV)) == SVt_IV) \ + & (do_taint ? !TAINT_get : 1))) \ + { \ + /* Cheap SvIOK_only(). \ + * Assert that flags which SvIOK_only() would test or \ + * clear can't be set, because we're SVt_IV */ \ + assert(!(SvFLAGS(_nsv) & \ + (SVf_OOK|SVf_UTF8|(SVf_OK & ~(SVf_IOK|SVp_IOK))))); \ + SvFLAGS(_nsv) |= (SVf_IOK|SVp_IOK); \ + /* SvIV_set() where sv_any points to head */ \ + _nsv->sv_u.svu_iv = TARGi_iv; \ + } \ + else \ + sv_setiv_mg(_nsv, TARGi_iv); \ + } \ +} STMT_END + +/* set TARG to the UV value u. If do_taint is false, + * assume that PL_tainted can never be true */ +#define TMR_TARGu(_nsv, u, do_taint) \ +STMT_START { \ + UV TARGu_uv = u; \ + if (GIMME_V == G_LIST || !(PL_op->op_private & OPpENTERSUB_HASTARG)) \ + _nsv = sv_2mortal(newSVuv(TARGu_uv)); \ + else { \ + _nsv = PAD_SV(PL_op->op_targ); \ + if (LIKELY( \ + ((SvFLAGS(_nsv) & (SVTYPEMASK|SVf_THINKFIRST|SVf_IVisUV)) == SVt_IV) \ + & (do_taint ? !TAINT_get : 1) \ + & (TARGu_uv <= (UV)IV_MAX))) \ + { \ + /* Cheap SvIOK_only(). \ + * Assert that flags which SvIOK_only() would test or \ + * clear can't be set, because we're SVt_IV */ \ + assert(!(SvFLAGS(_nsv) & \ + (SVf_OOK|SVf_UTF8|(SVf_OK & ~(SVf_IOK|SVp_IOK))))); \ + SvFLAGS(_nsv) |= (SVf_IOK|SVp_IOK); \ + /* SvIV_set() where sv_any points to head */ \ + _nsv->sv_u.svu_iv = TARGu_uv; \ + } \ + else \ + sv_setuv_mg(_nsv, TARGu_uv); \ + } \ +} STMT_END + +/* set TARG to the NV value n. If do_taint is false, + * assume that PL_tainted can never be true */ +#define TMR_TARGn(_nsv, n, do_taint) \ +STMT_START { \ + NV TARGn_nv = n; \ + if (GIMME_V == G_LIST || !(PL_op->op_private & OPpENTERSUB_HASTARG)) \ + _nsv = sv_2mortal(newSVnv(TARGn_nv)); \ + else { \ + _nsv = PAD_SV(PL_op->op_targ); \ + if (LIKELY( \ + ((SvFLAGS(_nsv) & (SVTYPEMASK|SVf_THINKFIRST)) == SVt_NV) \ + & (do_taint ? !TAINT_get : 1))) \ + { \ + /* Cheap SvNOK_only(). \ + * Assert that flags which SvNOK_only() would test or \ + * clear can't be set, because we're SVt_NV */ \ + assert(!(SvFLAGS(_nsv) & \ + (SVf_OOK|SVf_UTF8|(SVf_OK & ~(SVf_NOK|SVp_NOK))))); \ + SvFLAGS(_nsv) |= (SVf_NOK|SVp_NOK); \ + SvNV_set(_nsv, TARGn_nv); \ + } \ + else \ + sv_setnv_mg(_nsv, TARGn_nv); \ + } \ +} STMT_END + #define IV_1E6 1000000 #define IV_1E7 10000000 #define IV_1E9 1000000000 @@ -89,6 +214,12 @@ # undef ITIMER_REALPROF #endif +/* special type used by croak("unimplemented") XSUBs to neutralize */ +typedef NV NV_DIE; /* unused dXSTARG/sv_newmortal() calls */ +typedef I32 I32_DIE; + +#define die_t + #ifndef TIME_HIRES_CLOCKID_T typedef int clockid_t; #endif @@ -115,6 +246,10 @@ typedef int clockid_t; # define HAS_GETTIMEOFDAY # endif +# ifndef HAS_NV_GETTIMEOFDAY +# define HAS_NV_GETTIMEOFDAY +# endif + /* shows up in winsock.h? struct timeval { long tv_sec; @@ -130,13 +265,28 @@ typedef union { # 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; + unsigned long run_count; } my_cxt_t; +typedef BOOL (WINAPI *pfnQueryPerformanceCounter_T)(LARGE_INTEGER*); + +static unsigned __int64 tick_frequency = 0; +static NV tick_frequency_nv = 0; +static unsigned __int64 qpc_res_ns = 0; +static unsigned __int64 qpc_res_ns_realtime = 0; +static pfnQueryPerformanceCounter_T pfnQueryPerformanceCounter = NULL; + +#define S_InterlockedExchange64(_d,_s) \ + InterlockedExchange64((LONG64 volatile *)(_d),(LONG64)(_s)) +#define S_InterlockedExchangePointer(_d,_s) \ + InterlockedExchangePointer((PVOID volatile *)(_d),(PVOID)(_s)) + +#undef QueryPerformanceCounter +#define QueryPerformanceCounter pfnQueryPerformanceCounter + /* Visual C++ 2013 and older don't have the timespec structure. * Neither do mingw.org compilers with MinGW runtimes older than 3.22. */ # if((defined(_MSC_VER) && _MSC_VER < 1900) || \ @@ -178,14 +328,18 @@ START_MY_CXT for performance reasons */ # undef gettimeofday -# define gettimeofday(tp, not_used) _gettimeofday(aTHX_ tp, not_used) +# define gettimeofday(tp, not_used) ((*(tp) = _gettimeofday_x(aTHX)), 0) # undef GetSystemTimePreciseAsFileTime -# define GetSystemTimePreciseAsFileTime(out) _GetSystemTimePreciseAsFileTime(aTHX_ out) +# define GetSystemTimePreciseAsFileTime(out) (void)(*(out) = _GetSystemTimePreciseAsFileTime(aTHX)) # undef clock_gettime # define clock_gettime(clock_id, tp) _clock_gettime(aTHX_ clock_id, tp) +# define TIME_HIRES_NV_CLOCK_GETTIME +# undef nv_clock_gettime +# define nv_clock_gettime(clock_id, _bp) _nv_clock_gettime(aTHX_ clock_id, _bp) + # undef clock_getres # define clock_getres(clock_id, tp) _clock_getres(clock_id, tp) @@ -207,83 +361,135 @@ START_MY_CXT * Windows 8 introduced GetSystemTimePreciseAsFileTime(), but currently we have * to support older systems, so for now we provide our own implementation. * In the future we will switch to the real deal. + * + * FILETIME, switch to "return by copy", vs MS's "return by reference" prototype. + * We never take the fn ptr of static fn _GetSystemTimePreciseAsFileTime(pTHX). + * The MS API GetSystemTimePreciseAsFileTime() has a void return type but we + * have no reason to match ABI compatibility with MS's function symbol. + * Return by copy, encourages CC optimizations, since the C stack FILETIME var + * never escaped the function that declared it. This allows the CC, in the + * caller of _GetSystemTimePreciseAsFileTime(), to keep C stack FILETIME var + * in CPU registers at all times in its function body, if the CC wants to + * do that. + * + * Note even on Win64 x64, where "return by copy" return types > 8 bytes, become + * secret C++ "this"-style first arguments, a > 8 bytes "return by copy" retval + * is still more efficient!!! than explicitly passing a ptr to a C stack alloced + * temporary C struct in C code. The latter requires the CC to re-read the + * temporary C struct each time after any child function call, since the CC + * can't know if SvPV() or GetSystemTimePreciseAsFileTime(), permanently saved + * the pointer for long term Interlocked or Atomic message passing from an + * unknown 2nd OS thread running on another CPU Core. */ -static void -_GetSystemTimePreciseAsFileTime(pTHX_ FILETIME *out) + +static FILETIME +_GetSystemTimePreciseAsFileTime(pTHX) { - dMY_CXT; - FT_t ft; +#define MY_CXTX (*MY_CXT_x) + unsigned __int64 ticks; - if (MY_CXT.run_count++ == 0 || - MY_CXT.base_systime_as_filetime.ft_i64 > MY_CXT.reset_time) { + unsigned __int64 timesys; +/* If no threads, CC will probably optimize away all MY_CXT_x references + so they directly access the C static global struct. */ + my_cxt_t * MY_CXT_x; - 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; + { + unsigned __int64 ticks_mem; + QueryPerformanceCounter((LARGE_INTEGER*)&ticks_mem); + /* Inform the CC nothing external or in this fn (ptr aliasing) can ever + rewrite the value in ticks. Increases chance of CC using registers. */ + ticks = ticks_mem; + } + { + dMY_CXT; + MY_CXT_x = &(MY_CXT); + } + if (MY_CXTX.run_count++ == 0 || + MY_CXTX.base_systime_as_filetime.ft_i64 > MY_CXTX.reset_time) { + MY_CXTX.base_ticks = ticks; + GetSystemTimeAsFileTime(&MY_CXTX.base_systime_as_filetime.ft_val); + timesys = MY_CXTX.base_systime_as_filetime.ft_i64; + MY_CXTX.reset_time = timesys + MAX_PERF_COUNTER_TICKS; } else { __int64 diff; - unsigned __int64 ticks; - QueryPerformanceCounter((LARGE_INTEGER*)&ticks); - ticks -= MY_CXT.base_ticks; - ft.ft_i64 = MY_CXT.base_systime_as_filetime.ft_i64 - + Const64(IV_1E7) * (ticks / MY_CXT.tick_frequency) - +(Const64(IV_1E7) * (ticks % MY_CXT.tick_frequency)) / MY_CXT.tick_frequency; - diff = ft.ft_i64 - MY_CXT.base_systime_as_filetime.ft_i64; + ticks -= MY_CXTX.base_ticks; + timesys = MY_CXTX.base_systime_as_filetime.ft_i64 + + Const64(IV_1E7) * (ticks / tick_frequency) + +(Const64(IV_1E7) * (ticks % tick_frequency)) / tick_frequency; + diff = timesys - MY_CXTX.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; + MY_CXTX.base_ticks += ticks; + GetSystemTimeAsFileTime(&MY_CXTX.base_systime_as_filetime.ft_val); + timesys = MY_CXTX.base_systime_as_filetime.ft_i64; } + /* Note this invisible else {} branch, SKIPS calling GetSystemTimeAsFileTime() */ + } +#undef MY_CXTX + { + FT_t ft; + ft.ft_i64 = timesys; + return ft.ft_val; } +} - *out = ft.ft_val; +/* former prototype: static int _gettimeofday(pTHX_ struct timeval *tp, void *not_used); - return; -} + B/c _gettimeofday_x() is not capable of failing, and retval was always + constant 0, and its a static fn that never leaves this TU, repurpose the + retval for something better. */ -static int -_gettimeofday(pTHX_ struct timeval *tp, void *not_used) +PERL_STATIC_FORCE_INLINE struct timeval +_gettimeofday_x(pTHX) { FT_t ft; - - PERL_UNUSED_ARG(not_used); + struct timeval tp; GetSystemTimePreciseAsFileTime(&ft.ft_val); /* seconds since epoch */ - tp->tv_sec = (long)((ft.ft_i64 - EPOCH_BIAS) / Const64(IV_1E7)); + tp.tv_sec = (long)((ft.ft_i64 - EPOCH_BIAS) / Const64(IV_1E7)); /* microseconds remaining */ - tp->tv_usec = (long)((ft.ft_i64 / Const64(10)) % Const64(IV_1E6)); + tp.tv_usec = (long)((ft.ft_i64 / Const64(10)) % Const64(IV_1E6)); - return 0; + return tp; } -static int +PERL_STATIC_FORCE_INLINE NV +nv_gettimeofday_x(pTHX) +{ + FT_t ft; + + GetSystemTimePreciseAsFileTime(&ft.ft_val); + + /* FP seconds since epoch */ + return ((NV)((U64)((U64)ft.ft_i64) - ((U64)EPOCH_BIAS))) / ((NV)NV_1E7); +} +#define nv_gettimeofday() nv_gettimeofday_x(aTHX) + +/* force inline it, because XS_Time__HiRes_clock_gettime() is the only caller */ + +PERL_STATIC_FORCE_INLINE int _clock_gettime(pTHX_ clockid_t clock_id, struct timespec *tp) { - switch (clock_id) { - case CLOCK_REALTIME: { - FT_t ft; + FT_t ft; + unsigned __int64 ticks; + unsigned __int64 time_sys; + switch (clock_id) { + case CLOCK_REALTIME: GetSystemTimePreciseAsFileTime(&ft.ft_val); - tp->tv_sec = (time_t)((ft.ft_i64 - EPOCH_BIAS) / IV_1E7); - tp->tv_nsec = (long)((ft.ft_i64 % IV_1E7) * 100); + time_sys = ft.ft_i64; + tp->tv_sec = (time_t)((time_sys - EPOCH_BIAS) / IV_1E7); + tp->tv_nsec = (long)((time_sys % IV_1E7) * 100); break; - } - case CLOCK_MONOTONIC: { - unsigned __int64 freq, ticks; - - QueryPerformanceFrequency((LARGE_INTEGER*)&freq); - QueryPerformanceCounter((LARGE_INTEGER*)&ticks); - - tp->tv_sec = (time_t)(ticks / freq); - tp->tv_nsec = (long)((IV_1E9 * (ticks % freq)) / freq); + case CLOCK_MONOTONIC: + QueryPerformanceCounter((LARGE_INTEGER*)&ft.ft_i64); + ticks = ft.ft_i64; + tp->tv_sec = (time_t)(ticks / tick_frequency); + tp->tv_nsec = (long)((IV_1E9 * (ticks % tick_frequency)) / tick_frequency); break; - } default: errno = EINVAL; return 1; @@ -292,20 +498,37 @@ _clock_gettime(pTHX_ clockid_t clock_id, struct timespec *tp) return 0; } -static int -_clock_getres(clockid_t clock_id, struct timespec *tp) +PERL_STATIC_FORCE_INLINE NV +_nv_clock_gettime(pTHX_ clockid_t clock_id, bool * statusp) { - unsigned __int64 freq, qpc_res_ns; + FT_t ft; + unsigned __int64 ticks; + unsigned __int64 time_sys; - QueryPerformanceFrequency((LARGE_INTEGER*)&freq); - qpc_res_ns = IV_1E9 > freq ? IV_1E9 / freq : 1; + *statusp = 0; + switch (clock_id) { + case CLOCK_REALTIME: + GetSystemTimePreciseAsFileTime(&ft.ft_val); + time_sys = ft.ft_i64; + return ((NV)((U64)((U64)time_sys) - ((U64)EPOCH_BIAS))) / ((NV)NV_1E7); + case CLOCK_MONOTONIC: + QueryPerformanceCounter((LARGE_INTEGER*)&ft.ft_i64); + ticks = ft.ft_i64; + return ((NV)ticks) / tick_frequency_nv; + default: + *statusp = 1; + errno = EINVAL; + return -1.0; + } +} +static int +_clock_getres(clockid_t clock_id, struct timespec *tp) +{ switch (clock_id) { case CLOCK_REALTIME: tp->tv_sec = 0; - /* the resolution can't be smaller than 100ns because our implementation - * of CLOCK_REALTIME is using FILETIME internally */ - tp->tv_nsec = (long)(qpc_res_ns > 100 ? qpc_res_ns : 100); + tp->tv_nsec = (long)qpc_res_ns_realtime; break; case CLOCK_MONOTONIC: @@ -616,24 +839,55 @@ myU2time(pTHX_ UV *ret) return status; } +#ifdef PERL_IMPLICIT_CONTEXT +static NV myNVtime_cxt(pTHX); +#endif + static NV myNVtime() { # ifdef WIN32 dTHX; +# ifdef PERL_IMPLICIT_CONTEXT + return myNVtime_cxt(aTHX); +# endif # endif +#ifdef HAS_NV_GETTIMEOFDAY + return nv_gettimeofday(); +#else struct timeval Tp; int status; status = gettimeofday (&Tp, NULL); return status == 0 ? Tp.tv_sec + (Tp.tv_usec / NV_1E6) : -1.0; +#endif } +#ifdef PERL_IMPLICIT_CONTEXT + +static NV +myNVtime_cxt(pTHX) +{ +#ifdef HAS_NV_GETTIMEOFDAY + return nv_gettimeofday(); +#else + struct timeval Tp; + int status; + status = gettimeofday (&Tp, NULL); + return status == 0 ? Tp.tv_sec + (Tp.tv_usec / NV_1E6) : -1.0; +#endif +} + +#endif + #endif /* #ifdef HAS_GETTIMEOFDAY */ -static void -hrstatns(UV *atime_nsec, UV *mtime_nsec, UV *ctime_nsec) +/* Force inline this because it has only 1 caller: + XSUB void stat(...) PROTOTYPE: ;$ + Change back to plain "static", if in the future a 2nd call site is added */ + +PERL_STATIC_FORCE_INLINE void +S_hrstatns(pTHX_ UV *atime_nsec, UV *mtime_nsec, UV *ctime_nsec) { - dTHX; #if TIME_HIRES_STAT == 1 *atime_nsec = PL_statcache.st_atimespec.tv_nsec; *mtime_nsec = PL_statcache.st_mtimespec.tv_nsec; @@ -661,6 +915,8 @@ hrstatns(UV *atime_nsec, UV *mtime_nsec, UV *ctime_nsec) #endif /* !TIME_HIRES_STAT */ } +#define hrstatns(_at,_mt,_ct) S_hrstatns(aTHX_ (_at),(_mt),(_ct)) + /* Until Apple implements clock_gettime() * (ditto clock_getres() and clock_nanosleep()) * we will emulate them using the Mach kernel interfaces. */ @@ -912,21 +1168,126 @@ nsec_without_unslept(struct timespec *sleepfor, # define IS_SAFE_PATHNAME(pv, len, opname) (((len)>1)&&memchr((pv), 0, (len)-1)?(SETERRNO(ENOENT, LIB_INVARG),WARNEMU(opname),FALSE):(TRUE)) #endif +STATIC void +S_croak_xs_unimplemented(CV *const cv); + +STATIC void +S_croak_xs_unimplemented(CV *const cv) +{ + dTHX; + SV* sv = cv_name(cv, NULL, 0); + Perl_croak_nocontext( + "%s::%s(): unimplemented in this platform" + (sizeof("%s::")-1), SvPVX(sv)); +#if 0 /* former implementation, retired because of machine code bloat */ + char buf[sizeof("CODE(0x%" UVxf ")") + (sizeof(UV)*8)]; + const char * pv1; + const GV *const gv = CvGV(cv); + if (gv) { + const char *const gvname = GvNAME(gv); + const HV *const stash = GvSTASH(gv); + const char *const hvname = stash ? HvNAME(stash) : NULL; + if (hvname) + Perl_croak_nocontext("%s::%s(): unimplemented in this platform", + hvname, gvname); + else { + pv1 = gvname; + goto one_str; + } + } else { + my_sprintf(buf, sizeof(buf), "CODE(0x%" UVxf ")", PTR2UV(cv)); + pv1 = buf; + + one_str: + Perl_croak_nocontext( + "%s::%s(): unimplemented in this platform" + (sizeof("%s::")-1), + pv1); + } +#endif +} +#define croak_xs_unimplemented S_croak_xs_unimplemented + MODULE = Time::HiRes PACKAGE = Time::HiRes PROTOTYPES: ENABLE BOOT: { + if (items != 3) + croak_xs_usage(cv,"cls,ver,exok"); #ifdef MY_CXT_KEY MY_CXT_INIT; #endif +#if defined(WIN32) || defined(CYGWIN_WITH_W32API) +{ + unsigned __int64 l_qpc_res_ns; + unsigned __int64 l_qpc_res_ns_realtime; + unsigned __int64 l_tick_frequency = tick_frequency; + if (l_tick_frequency == 0) { /* no DllMain() in very rare static Perls */ +/* from MSDN: >= WinXP, function will always succeed and never return zero */ + unsigned __int64 l_tick_frequency_mem; + if (!QueryPerformanceFrequency((LARGE_INTEGER*)&l_tick_frequency_mem)) + croak("%s::%s(): unimplemented in this platform" + (sizeof("%s::")-1), + "QueryPerformanceFrequency"); + l_tick_frequency = l_tick_frequency_mem; + /* 32-bit CPU anti-sharding paranoia */ + tick_frequency_nv = (NV)l_tick_frequency; + S_InterlockedExchange64(&tick_frequency, l_tick_frequency); + } + l_qpc_res_ns = qpc_res_ns; + if (l_qpc_res_ns == 0) { + l_qpc_res_ns = IV_1E9 > l_tick_frequency ? IV_1E9 / l_tick_frequency : 1; + S_InterlockedExchange64(&qpc_res_ns, l_qpc_res_ns); + } + l_qpc_res_ns_realtime = qpc_res_ns_realtime; + if (l_qpc_res_ns_realtime == 0) { + /* the resolution can't be smaller than 100ns because our implementation + * of CLOCK_REALTIME is using FILETIME internally */ + l_qpc_res_ns_realtime = l_qpc_res_ns > 100 ? l_qpc_res_ns : 100; + S_InterlockedExchange64(&qpc_res_ns_realtime, l_qpc_res_ns_realtime); + } + {/* Remove a couple jump stub funcs between kernel32->kernelbase->ntdll + for perf reasons. RtlQueryPerformanceCounter() was added in NT 6.1, + so a fallback path is still required to QPC()@K32.dll. */ + pfnQueryPerformanceCounter_T QPCfn = pfnQueryPerformanceCounter; + if (!QPCfn) { + HMODULE hmod = GetModuleHandleW(L"NTDLL.DLL"); + if (hmod) { + QPCfn = (pfnQueryPerformanceCounter_T)GetProcAddress(hmod,"RtlQueryPerformanceCounter"); + if (QPCfn) + goto QPC_done; + } +#undef QueryPerformanceCounter + QPCfn = QueryPerformanceCounter; /* Get the public API fallback sym. */ +#undef QueryPerformanceCounter +#QueryPerformanceCounter pfnQueryPerformanceCounter + QPC_done: + S_InterlockedExchangePointer(&pfnQueryPerformanceCounter, QPCfn); + } + } +} +#endif #ifdef HAS_GETTIMEOFDAY { - (void) hv_store(PL_modglobal, "Time::NVtime", 12, - newSViv(PTR2IV(myNVtime)), 0); - (void) hv_store(PL_modglobal, "Time::U2time", 12, - newSViv(PTR2IV(myU2time)), 0); + SV* sv = newSV_type(SVt_PVIV); +#ifdef PERL_IMPLICIT_CONTEXT + const static NV (* const pMyNVtime_cxt)(pTHX) = myNVtime_cxt; +#else + const static NV (* const pMyNVtime_cxt)(pTHX) = myNVtime; +#endif +/* Don't bother making a 5/9 byte struct{void*; char;} just for '\0'. + It is 8/16 bytes after padding. This SVPV will never be "printed". */ + SvCUR_set(sv, sizeof(pMyNVtime_cxt)); + SvLEN_set(sv, 0); + SvIV_set(sv, PTR2IV(myNVtime)); + SvPV_set(sv, (char *)(&pMyNVtime_cxt)); + SvPOK_on(sv); + SvIOK_on(sv); + SvREADONLY_on(sv); + { + HV* const modglobal = PL_modglobal; + (void)hv_stores(modglobal, "Time::NVtime", sv); + (void)hv_stores(modglobal, "Time::U2time", newSViv(PTR2IV(myU2time))); + } } #endif #if defined(PERL_DARWIN) @@ -934,6 +1295,106 @@ BOOT: MUTEX_INIT(&darwin_time_mutex); # endif #endif +#if defined(HAS_GETITIMER) && defined(HAS_SETITIMER) +# define GETITIMER_SUBSTR "Time::HiRes::getitimer"+13 +# define SETITIMER_SUBSTR "Time::HiRes::setitimer"+13 +#else +# define GETITIMER_SUBSTR "d_getitimer"+2 +# define SETITIMER_SUBSTR "d_setitimer"+2 +#endif +#define INIT1 INIT2(sym_usleep, "Time::HiRes::usleep"+13, sizeof("usleep")-1, NULL, 0) \ +INIT2(sym_sleep, "Time::HiRes::sleep"+13, sizeof("sleep")-1, NULL, 0) \ +INIT2(sym_ualarm, "Time::HiRes::ualarm"+13, sizeof("ualarm")-1, NULL, 0) \ +INIT2(sym_alarm, "Time::HiRes::alarm"+13, sizeof("alarm")-1, NULL, 0) \ +INIT2(sym_gettimeofday, "Time::HiRes::gettimeofday"+13, sizeof("gettimeofday")-1, NULL, 0) \ +INIT2(sym_time, "Time::HiRes::time"+13, sizeof("time")-1, NULL, 0) \ +INIT2(sym_tv_interval, "tv_interval", sizeof("tv_interval")-1, NULL, 0) \ +INIT2(sym_getitimer, GETITIMER_SUBSTR, sizeof("getitimer")-1, NULL, 0) \ +INIT2(sym_setitimer, SETITIMER_SUBSTR, sizeof("setitimer")-1, NULL, 0) \ +INIT2(sym_nanosleep, "Time::HiRes::nanosleep"+13, sizeof("nanosleep")-1, NULL, 0) \ +INIT2(sym_clock_gettime, "Time::HiRes::clock_gettime"+13, sizeof("clock_gettime")-1, NULL, 0) \ +INIT2(sym_clock_getres, "Time::HiRes::clock_getres"+13, sizeof("clock_getres")-1, NULL, 0) \ +INIT2(sym_clock, "Time::HiRes::clock"+13, sizeof("clock")-1, NULL, 0) \ +INIT2(sym_clock_nanosleep, "Time::HiRes::clock_nanosleep"+13, sizeof("clock_nanosleep")-1, NULL, 0) \ +INIT2(sym_CLOCKS_PER_SEC, "CLOCKS_PER_SEC", sizeof("CLOCKS_PER_SEC")-1, NULL, 0) \ +INIT2(sym_CLOCK_BOOTTIME, "CLOCK_BOOTTIME", sizeof("CLOCK_BOOTTIME")-1, NULL, 0) \ +INIT2(sym_CLOCK_HIGHRES, "CLOCK_HIGHRES", sizeof("CLOCK_HIGHRES")-1, NULL, 0) \ +INIT2(sym_CLOCK_MONOTONIC, "CLOCK_MONOTONIC", sizeof("CLOCK_MONOTONIC")-1, NULL, 0) \ +INIT2(sym_CLOCK_MONOTONIC_COARSE, "CLOCK_MONOTONIC_COARSE", sizeof("CLOCK_MONOTONIC_COARSE")-1, NULL, 0) \ +INIT2(sym_CLOCK_MONOTONIC_FAST, "CLOCK_MONOTONIC_FAST", sizeof("CLOCK_MONOTONIC_FAST")-1, NULL, 0) \ +INIT2(sym_CLOCK_MONOTONIC_PRECISE, "CLOCK_MONOTONIC_PRECISE", sizeof("CLOCK_MONOTONIC_PRECISE")-1, NULL, 0) \ +INIT2(sym_CLOCK_MONOTONIC_RAW, "CLOCK_MONOTONIC_RAW", sizeof("CLOCK_MONOTONIC_RAW")-1, NULL, 0) \ +INIT2(sym_CLOCK_PROCESS_CPUTIME_ID, "CLOCK_PROCESS_CPUTIME_ID", sizeof("CLOCK_PROCESS_CPUTIME_ID")-1, NULL, 0) \ +INIT2(sym_CLOCK_PROF, "CLOCK_PROF", sizeof("CLOCK_PROF")-1, NULL, 0) \ +INIT2(sym_CLOCK_REALTIME, "CLOCK_REALTIME", sizeof("CLOCK_REALTIME")-1, NULL, 0) \ +INIT2(sym_CLOCK_REALTIME_COARSE, "CLOCK_REALTIME_COARSE", sizeof("CLOCK_REALTIME_COARSE")-1, NULL, 0) \ +INIT2(sym_CLOCK_REALTIME_FAST, "CLOCK_REALTIME_FAST", sizeof("CLOCK_REALTIME_FAST")-1, NULL, 0) \ +INIT2(sym_CLOCK_REALTIME_PRECISE, "CLOCK_REALTIME_PRECISE", sizeof("CLOCK_REALTIME_PRECISE")-1, NULL, 0) \ +INIT2(sym_CLOCK_REALTIME_RAW, "CLOCK_REALTIME_RAW", sizeof("CLOCK_REALTIME_RAW")-1, NULL, 0) \ +INIT2(sym_CLOCK_SECOND, "CLOCK_SECOND", sizeof("CLOCK_SECOND")-1, NULL, 0) \ +INIT2(sym_CLOCK_SOFTTIME, "CLOCK_SOFTTIME", sizeof("CLOCK_SOFTTIME")-1, NULL, 0) \ +INIT2(sym_CLOCK_THREAD_CPUTIME_ID, "CLOCK_THREAD_CPUTIME_ID", sizeof("CLOCK_THREAD_CPUTIME_ID")-1, NULL, 0) \ +INIT2(sym_CLOCK_TIMEOFDAY, "CLOCK_TIMEOFDAY", sizeof("CLOCK_TIMEOFDAY")-1, NULL, 0) \ +INIT2(sym_CLOCK_UPTIME, "CLOCK_UPTIME", sizeof("CLOCK_UPTIME")-1, NULL, 0) \ +INIT2(sym_CLOCK_UPTIME_COARSE, "CLOCK_UPTIME_COARSE", sizeof("CLOCK_UPTIME_COARSE")-1, NULL, 0) \ +INIT2(sym_CLOCK_UPTIME_FAST, "CLOCK_UPTIME_FAST", sizeof("CLOCK_UPTIME_FAST")-1, NULL, 0) \ +INIT2(sym_CLOCK_UPTIME_PRECISE, "CLOCK_UPTIME_PRECISE", sizeof("CLOCK_UPTIME_PRECISE")-1, NULL, 0) \ +INIT2(sym_CLOCK_UPTIME_RAW, "CLOCK_UPTIME_RAW", sizeof("CLOCK_UPTIME_RAW")-1, NULL, 0) \ +INIT2(sym_CLOCK_VIRTUAL, "CLOCK_VIRTUAL", sizeof("CLOCK_VIRTUAL")-1, NULL, 0) \ +INIT2(sym_ITIMER_PROF, "ITIMER_PROF", sizeof("ITIMER_PROF")-1, NULL, 0) \ +INIT2(sym_ITIMER_REAL, "ITIMER_REAL", sizeof("ITIMER_REAL")-1, NULL, 0) \ +INIT2(sym_ITIMER_REALPROF, "ITIMER_REALPROF", sizeof("ITIMER_REALPROF")-1, NULL, 0) \ +INIT2(sym_ITIMER_VIRTUAL, "ITIMER_VIRTUAL", sizeof("ITIMER_VIRTUAL")-1, NULL, 0) \ +INIT2(sym_TIMER_ABSTIME, "TIMER_ABSTIME", sizeof("TIMER_ABSTIME")-1, NULL, 0) \ +INIT2(sym_d_usleep, "d_usleep", sizeof("d_usleep")-1, "Time::HiRes::usleep"+13, 1) \ +INIT2(sym_d_ualarm, "d_ualarm", sizeof("d_ualarm")-1, "Time::HiRes::ualarm"+13, 1) \ +INIT2(sym_d_gettimeofday, "d_gettimeofday", sizeof("d_gettimeofday")-1, "Time::HiRes::gettimeofday"+13, 1) \ +INIT2(sym_d_getitimer, "d_getitimer", sizeof("d_getitimer")-1, GETITIMER_SUBSTR, 1) \ +INIT2(sym_d_setitimer, "d_setitimer", sizeof("d_setitimer")-1, SETITIMER_SUBSTR, 1) \ +INIT2(sym_d_nanosleep, "d_nanosleep", sizeof("d_nanosleep")-1, "Time::HiRes::nanosleep"+13, 1) \ +INIT2(sym_d_clock_gettime, "d_clock_gettime", sizeof("d_clock_gettime")-1, "Time::HiRes::clock_gettime"+13, 1) \ +INIT2(sym_d_clock_getres, "d_clock_getres", sizeof("d_clock_getres")-1, "Time::HiRes::clock_getres"+13, 1) \ +INIT2(sym_d_clock, "d_clock", sizeof("d_clock")-1, "Time::HiRes::clock"+13, 1) \ +INIT2(sym_d_clock_nanosleep, "d_clock_nanosleep", sizeof("d_clock_nanosleep")-1, "Time::HiRes::clock_nanosleep"+13, 1) \ +INIT2(sym_d_hires_stat, "d_hires_stat", sizeof("d_hires_stat")-1, NULL, 0) \ +INIT2(sym_d_futimens, "d_futimens", sizeof("d_futimens")-1, "futimens", 1) \ +INIT2(sym_d_utimensat, "d_utimensat", sizeof("d_utimensat")-1, "utimensat", 1) \ +INIT2(sym_d_hires_utime, "d_hires_utime", sizeof("d_hires_utime")-1, NULL, 0) \ +INIT2(sym_stat, "Time::HiRes::stat"+13, sizeof("stat")-1, NULL, 0) \ +INIT2(sym_lstat, "Time::HiRes::lstat"+13, sizeof("lstat")-1, NULL, 0) \ +INIT2(sym_utime, "Time::HiRes::utime"+13, sizeof("utime")-1, NULL, 0) +#undef INIT2 +#define INIT2(_s, _str, _l, _d, _db) ((_db) ? (_d) : (_str)), + { + const static char * expokpv[] = { + INIT1 + }; +#undef INIT2 +#define INIT2(_s, _str, _l, _d, _db) ((_db) ? -((I8)(_l)) : (_l)), + const static I8 expoklen[] = { + INIT1 + }; +#undef INIT2 + char buf [64]; + SV* rv = ST(2);/* 3 items check above */ + AV* av = MUTABLE_AV(SvRV(rv)); + int i = 0; + buf[0] = 'd'; + buf[1] = '_'; + if( !SvROK(rv) || SvTYPE(av) != SVt_PVAV) + croak_xs_usage(cv,"cls,ver,expok"); + av_extend(av, C_ARRAY_LENGTH(expoklen)); + for(;i < C_ARRAY_LENGTH(expoklen); i++) { + I8 l = expoklen[i]; + const char * pv = expokpv[i]; + if (l < 0) { + l = -l; + Copy(pv, &buf[2], (l+1)-2, char); + pv = buf; + } + av_push(av, newSVpvn_share(pv, l, 0)); + } + } } #if defined(USE_ITHREADS) && defined(MY_CXT_KEY) @@ -949,13 +1410,23 @@ INCLUDE: const-xs.inc #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) -NV +void usleep(useconds) NV useconds PREINIT: +#ifndef HAS_NV_GETTIMEOFDAY struct timeval Ta, Tb; +#else + NV Ta_nv, Tb_nv; +#endif + SV* rsv; + NV RETVAL; CODE: +#ifndef HAS_NV_GETTIMEOFDAY gettimeofday(&Ta, NULL); +#else + Ta_nv = nv_gettimeofday(); +#endif if (items > 0) { if (useconds >= NV_1E6) { IV seconds = (IV) (useconds / NV_1E6); @@ -967,62 +1438,79 @@ usleep(useconds) useconds -= NV_1E6 * seconds; } } else if (useconds < 0.0) - croak("Time::HiRes::usleep(%" NVgf - "): negative time not invented yet", useconds); - + croak("%s(%" NVgf "%s", + "Time::HiRes::usleep", useconds, + "): negative time not invented yet"); usleep((U32)useconds); } else PerlProc_pause(); - +#ifndef HAS_NV_GETTIMEOFDAY gettimeofday(&Tb, NULL); # if 0 printf("[%ld %ld] [%ld %ld]\n", Tb.tv_sec, Tb.tv_usec, Ta.tv_sec, Ta.tv_usec); # endif RETVAL = NV_1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec); - - OUTPUT: - RETVAL +#else + Tb_nv = nv_gettimeofday(); + RETVAL = NV_1E6*(Tb_nv - Ta_nv); +#endif + TMR_TARGn(rsv, RETVAL, 1); + SETs(rsv); + return; /* no PUTBACK no PUSH, 1 in, 1 out */ # if defined(TIME_HIRES_NANOSLEEP) -NV +void nanosleep(nsec) NV nsec PREINIT: struct timespec sleepfor, unslept; + SV* rsv; + NV RETVAL; CODE: if (nsec < 0.0) - croak("Time::HiRes::nanosleep(%" NVgf - "): negative time not invented yet", nsec); + croak("%s(%" NVgf "%s", "Time::HiRes::nanosleep", nsec, + "): negative time not invented yet"); nanosleep_init(nsec, &sleepfor, &unslept); if (nanosleep(&sleepfor, &unslept) == 0) { RETVAL = nsec; } else { RETVAL = nsec_without_unslept(&sleepfor, &unslept); } - OUTPUT: - RETVAL + TMR_TARGn(rsv, RETVAL, 1); + SETs(rsv); + return; /* no PUTBACK no PUSH, 1 in, 1 out */ # else /* #if defined(TIME_HIRES_NANOSLEEP) */ -NV +NV_DIE nanosleep(nsec) - NV nsec + NV_DIE nsec CODE: PERL_UNUSED_ARG(nsec); - croak("Time::HiRes::nanosleep(): unimplemented in this platform"); + croak_xs_unimplemented(cv); RETVAL = 0.0; OUTPUT: RETVAL # endif /* #if defined(TIME_HIRES_NANOSLEEP) */ -NV +void sleep(...) PREINIT: +#ifndef HAS_NV_GETTIMEOFDAY struct timeval Ta, Tb; - CODE: +#else + NV Ta_nv, Tb_nv; +#endif + SV* rsv; + NV RETVAL; + PPCODE: +#ifndef HAS_NV_GETTIMEOFDAY gettimeofday(&Ta, NULL); +#else + Ta_nv = nv_gettimeofday(); +#endif if (items > 0) { NV seconds = SvNV(ST(0)); if (seconds >= 0.0) { @@ -1038,35 +1526,41 @@ sleep(...) useconds = -(IV)useconds; # endif /* #if defined(__sparc64__) && defined(__GNUC__) */ if ((IV)useconds < 0) - croak("Time::HiRes::sleep(%" NVgf + croak("%s(%" NVgf "): internal error: useconds < 0 (unsigned %" UVuf - " signed %" IVdf ")", + " signed %" IVdf ")", "Time::HiRes::sleep", seconds, useconds, (IV)useconds); } usleep(useconds); } else - croak("Time::HiRes::sleep(%" NVgf - "): negative time not invented yet", seconds); + croak("%s(%" NVgf "%s", + "Time::HiRes::sleep", seconds, + "): negative time not invented yet"); } else PerlProc_pause(); - +#ifndef HAS_NV_GETTIMEOFDAY gettimeofday(&Tb, NULL); # if 0 printf("[%ld %ld] [%ld %ld]\n", Tb.tv_sec, Tb.tv_usec, Ta.tv_sec, Ta.tv_usec); # endif RETVAL = (NV)(Tb.tv_sec-Ta.tv_sec)+0.000001*(NV)(Tb.tv_usec-Ta.tv_usec); - - OUTPUT: - RETVAL +#else + Tb_nv = nv_gettimeofday(); + RETVAL = Tb_nv - Ta_nv; +#endif + TMR_TARGn(rsv, RETVAL, 1); + PUSHs(rsv); + PUTBACK; + return; #else /* #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) */ -NV +NV_DIE usleep(useconds) - NV useconds + NV_DIE useconds CODE: PERL_UNUSED_ARG(useconds); - croak("Time::HiRes::usleep(): unimplemented in this platform"); + croak_xs_unimplemented(cv); RETVAL = 0.0; OUTPUT: RETVAL @@ -1075,13 +1569,18 @@ usleep(useconds) #ifdef HAS_UALARM -IV +void ualarm(useconds,uinterval=0) int useconds int uinterval - CODE: + PREINIT: + SV* rsv; + IV RETVAL; + PPCODE: if (useconds < 0 || uinterval < 0) - croak("Time::HiRes::ualarm(%d, %d): negative time not invented yet", useconds, uinterval); + croak("%s(%d, %d%s", + "Time::HiRes::ualarm", useconds, uinterval, + "): negative time not invented yet"); # if defined(HAS_SETITIMER) && defined(ITIMER_REAL) { struct itimerval itv; @@ -1101,19 +1600,23 @@ ualarm(useconds,uinterval=0) RETVAL = ualarm(useconds, uinterval); # endif + TMR_TARGi(rsv, RETVAL, 1); + PUSHs(rsv); + PUTBACK; + return; - OUTPUT: - RETVAL - -NV +void alarm(seconds,interval=0) NV seconds NV interval - CODE: + PREINIT: + SV* rsv; + NV RETVAL; + PPCODE: if (seconds < 0.0 || interval < 0.0) - croak("Time::HiRes::alarm(%" NVgf ", %" NVgf - "): negative time not invented yet", seconds, interval); - + croak("%s(%" NVgf ", %" NVgf "%s", + "Time::HiRes::alarm", seconds, interval, + "): negative time not invented yet"); { IV iseconds = (IV)seconds; IV iinterval = (IV)interval; @@ -1151,32 +1654,33 @@ alarm(seconds,interval=0) RETVAL = (NV)ualarm( useconds, uinterval ) / NV_1E6; # endif } - - OUTPUT: - RETVAL + TMR_TARGn(rsv, RETVAL, 1); + PUSHs(rsv); + PUTBACK; + return; #else /* #ifdef HAS_UALARM */ -int +int die_t ualarm(useconds,interval=0) - int useconds - int interval + int die_t useconds + int die_t interval CODE: PERL_UNUSED_ARG(useconds); PERL_UNUSED_ARG(interval); - croak("Time::HiRes::ualarm(): unimplemented in this platform"); + croak_xs_unimplemented(cv); RETVAL = -1; OUTPUT: RETVAL -NV +NV_DIE alarm(seconds,interval=0) - NV seconds - NV interval + NV_DIE seconds + NV_DIE interval CODE: PERL_UNUSED_ARG(seconds); PERL_UNUSED_ARG(interval); - croak("Time::HiRes::alarm(): unimplemented in this platform"); + croak_xs_unimplemented(cv); RETVAL = 0.0; OUTPUT: RETVAL @@ -1185,38 +1689,94 @@ alarm(seconds,interval=0) #ifdef HAS_GETTIMEOFDAY +#ifdef HAS_NV_GETTIMEOFDAY +# define HAS_NV_GETTIMEOFDAY_BOOL 1 +#else +# define HAS_NV_GETTIMEOFDAY_BOOL 0 +#endif + void gettimeofday() PREINIT: struct timeval Tp; - PPCODE: int status; + OP* const op = PL_op; + U8 is_G_LIST = GIMME_V == G_LIST; + NV nv; + const U8 do_taint = 1; + PPCODE: + if (is_G_LIST) + EXTEND(sp, 2); + else if(HAS_NV_GETTIMEOFDAY_BOOL) { +#ifdef HAS_NV_GETTIMEOFDAY + nv = nv_gettimeofday(); +#endif + goto ret_1_nv; + } status = gettimeofday (&Tp, NULL); if (status == 0) { - if (GIMME_V == G_LIST) { - EXTEND(sp, 2); - PUSHs(sv_2mortal(newSViv(Tp.tv_sec))); - PUSHs(sv_2mortal(newSViv(Tp.tv_usec))); + if (HAS_NV_GETTIMEOFDAY_BOOL || is_G_LIST) { + /* copy to registers to prove sv_2mortal/newSViv */ + IV sec = Tp.tv_sec; /* can't modify the values */ + IV usec = Tp.tv_usec; + PUSHs(sv_2mortal(newSViv(sec))); + PUSHs(sv_2mortal(newSViv(usec))); } else { - EXTEND(sp, 1); - PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec / NV_1E6)))); + /* no Perl_leave_adjust_stacks() hazard here, + only a PP vs call_sv() hazard */ + NV TARGn_nv; + SV* rsv; + nv = Tp.tv_sec + (Tp.tv_usec / NV_1E6); + + ret_1_nv: + TARGn_nv = nv; + if (op->op_private & OPpENTERSUB_HASTARG) { + rsv = PAD_SV(op->op_targ); + if (LIKELY( + ((SvFLAGS(rsv) & (SVTYPEMASK|SVf_THINKFIRST)) == SVt_NV) + & (do_taint ? !TAINT_get : 1))) + { + /* Cheap SvNOK_only(). + * Assert that flags which SvNOK_only() would test or + * clear can't be set, because we're SVt_NV */ + assert(!(SvFLAGS(rsv) & + (SVf_OOK|SVf_UTF8|(SVf_OK & ~(SVf_NOK|SVp_NOK))))); + SvFLAGS(rsv) |= (SVf_NOK|SVp_NOK); + SvNV_set(rsv, TARGn_nv); + } + else + sv_setnv_mg(rsv, TARGn_nv); + } + else + rsv = sv_2mortal(newSVnv(TARGn_nv)); + PUSHs(rsv); } } -NV +void time() PREINIT: + SV* rsv; + NV RETVAL; +#ifndef HAS_NV_GETTIMEOFDAY struct timeval Tp; - CODE: int status; +#endif + CODE: +#ifndef HAS_NV_GETTIMEOFDAY status = gettimeofday (&Tp, NULL); if (status == 0) { RETVAL = Tp.tv_sec + (Tp.tv_usec / NV_1E6); } else { RETVAL = -1.0; } - OUTPUT: - RETVAL +#else + RETVAL = nv_gettimeofday(); +#endif + TMR_TARGn(rsv, RETVAL, 1); + PUSHs(rsv); /* 0 in, 1 out, entersub guarenteed 1 slot */ + PUTBACK; + return; #endif /* #ifdef HAS_GETTIMEOFDAY */ @@ -1234,9 +1794,10 @@ setitimer(which, seconds, interval = 0) struct itimerval oldit; PPCODE: if (seconds < 0.0 || interval < 0.0) - croak("Time::HiRes::setitimer(%" IVdf ", %" NVgf ", %" NVgf - "): negative time not invented yet", - (IV)which, seconds, interval); + croak("%s(%" IVdf ", %" NVgf ", %" NVgf "%s", + "Time::HiRes::setitimer", + (IV)which, seconds, interval, + "): negative time not invented yet"); newit.it_value.tv_sec = (IV)seconds; newit.it_value.tv_usec = (IV)((seconds - (NV)newit.it_value.tv_sec) * NV_1E6); @@ -1248,10 +1809,8 @@ setitimer(which, seconds, interval = 0) */ GCC_DIAG_IGNORE_CPP_COMPAT_STMT; if (setitimer(which, &newit, &oldit) == 0) { - EXTEND(sp, 1); PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_value)))); if (GIMME_V == G_LIST) { - EXTEND(sp, 1); PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_interval)))); } } @@ -1268,7 +1827,6 @@ getitimer(which) */ GCC_DIAG_IGNORE_CPP_COMPAT_STMT; if (getitimer(which, &nowit) == 0) { - EXTEND(sp, 1); PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_value)))); if (GIMME_V == G_LIST) { EXTEND(sp, 1); @@ -1302,28 +1860,31 @@ PROTOTYPE: $$@ if ( accessed == &PL_sv_undef && modified == &PL_sv_undef ) utbufp = NULL; else { - if (SvNV(accessed) < 0.0 || SvNV(modified) < 0.0) - croak("Time::HiRes::utime(%" NVgf ", %" NVgf - "): negative time not invented yet", - SvNV(accessed), SvNV(modified)); + NV modified_nv = SvNV(modified); + NV accessed_nv = SvNV(accessed); + if (accessed_nv < 0.0 || modified_nv < 0.0) + croak("%s(%" NVgf ", %" NVgf "%s", "Time::HiRes::utime", + accessed_nv, modified_nv, + "): negative time not invented yet"); Zero(&utbuf, sizeof utbuf, char); - utbuf[0].tv_sec = (Time_t)SvNV(accessed); /* time accessed */ + utbuf[0].tv_sec = (Time_t)accessed_nv; /* time accessed */ utbuf[0].tv_nsec = (long)( - (SvNV(accessed) - (NV)utbuf[0].tv_sec) + (accessed_nv - (NV)utbuf[0].tv_sec) * NV_1E9 + (NV)0.5); - utbuf[1].tv_sec = (Time_t)SvNV(modified); /* time modified */ + utbuf[1].tv_sec = (Time_t)modified_nv; /* time modified */ utbuf[1].tv_nsec = (long)( - (SvNV(modified) - (NV)utbuf[1].tv_sec) + (modified_nv - (NV)utbuf[1].tv_sec) * NV_1E9 + (NV)0.5); } while (items > 0) { + PerlIO * pio; file = POPs; items--; - if (SvROK(file) && GvIO(SvRV(file)) && IoIFP(sv_2io(SvRV(file)))) { - int fd = PerlIO_fileno(IoIFP(sv_2io(file))); + if (SvROK(file) && GvIO(SvRV(file)) && (pio = IoIFP(sv_2io(SvRV(file))))) { + int fd = PerlIO_fileno(pio); if (fd < 0) { SETERRNO(EBADF,RMS_IFI); } else { @@ -1333,10 +1894,10 @@ PROTOTYPE: $$@ tot++; } } else { - croak("futimens unimplemented in this platform"); + croak("%s unimplemented in this platform", "futimens"); } # else /* HAS_FUTIMENS */ - croak("futimens unimplemented in this platform"); + croak("%s unimplemented in this platform", "futimens"); # endif /* HAS_FUTIMENS */ } } @@ -1344,17 +1905,17 @@ PROTOTYPE: $$@ # ifdef HAS_UTIMENSAT if (UTIMENSAT_AVAILABLE) { STRLEN len; - char * name = SvPV(file, len); + const char * name = SvPV_const(file, len); if (IS_SAFE_PATHNAME(name, len, "utime") && utimensat(AT_FDCWD, name, utbufp, 0) == 0) { tot++; } } else { - croak("utimensat unimplemented in this platform"); + croak("%s unimplemented in this platform", "utimensat"); } # else /* HAS_UTIMENSAT */ - croak("utimensat unimplemented in this platform"); + croak("%s unimplemented in this platform", "utimensat"); # endif /* HAS_UTIMENSAT */ } } /* while items */ @@ -1365,10 +1926,10 @@ PROTOTYPE: $$@ #else /* #if defined(TIME_HIRES_UTIME) */ -I32 +I32_DIE utime(accessed, modified, ...) CODE: - croak("Time::HiRes::utime(): unimplemented in this platform"); + croak_xs_unimplemented(cv); RETVAL = 0; OUTPUT: RETVAL @@ -1377,31 +1938,44 @@ utime(accessed, modified, ...) #if defined(TIME_HIRES_CLOCK_GETTIME) -NV +void clock_gettime(clock_id = CLOCK_REALTIME) clockid_t clock_id PREINIT: +#ifndef TIME_HIRES_NV_CLOCK_GETTIME struct timespec ts; - int status = -1; - CODE: + int status; +#endif + SV* rsv; + NV RETVAL; + PPCODE: # ifdef TIME_HIRES_CLOCK_GETTIME_SYSCALL status = syscall(SYS_clock_gettime, clock_id, &ts); # else +# ifndef TIME_HIRES_NV_CLOCK_GETTIME status = clock_gettime(clock_id, &ts); -# endif RETVAL = status == 0 ? ts.tv_sec + (NV) ts.tv_nsec / NV_1E9 : -1; - - OUTPUT: - RETVAL +# else + { + bool status; + NV nv = nv_clock_gettime(clock_id, &status); + RETVAL = status == 0 ? nv : -1; + } +# endif +# endif + TMR_TARGn(rsv, RETVAL, 1); + PUSHs(rsv); /* 0 or 1 in, 1 out, PPCODE: did rewind */ + PUTBACK; + return; #else /* if defined(TIME_HIRES_CLOCK_GETTIME) */ -NV +NV_DIE clock_gettime(clock_id = 0) - clockid_t clock_id + clockid_t die_t clock_id CODE: PERL_UNUSED_ARG(clock_id); - croak("Time::HiRes::clock_gettime(): unimplemented in this platform"); + croak_xs_unimplemented(cv); RETVAL = 0.0; OUTPUT: RETVAL @@ -1414,7 +1988,7 @@ NV clock_getres(clock_id = CLOCK_REALTIME) clockid_t clock_id PREINIT: - int status = -1; + int status; struct timespec ts; CODE: # ifdef TIME_HIRES_CLOCK_GETRES_SYSCALL @@ -1429,12 +2003,12 @@ clock_getres(clock_id = CLOCK_REALTIME) #else /* if defined(TIME_HIRES_CLOCK_GETRES) */ -NV +NV_DIE clock_getres(clock_id = 0) - clockid_t clock_id + clockid_t die_t clock_id CODE: PERL_UNUSED_ARG(clock_id); - croak("Time::HiRes::clock_getres(): unimplemented in this platform"); + croak_xs_unimplemented(cv); RETVAL = 0.0; OUTPUT: RETVAL @@ -1452,8 +2026,9 @@ clock_nanosleep(clock_id, nsec, flags = 0) struct timespec sleepfor, unslept; CODE: if (nsec < 0.0) - croak("Time::HiRes::clock_nanosleep(..., %" NVgf - "): negative time not invented yet", nsec); + croak("%s(..., %" NVgf "%s", + "Time::HiRes::clock_nanosleep", nsec, + "): negative time not invented yet"); nanosleep_init(nsec, &sleepfor, &unslept); if (clock_nanosleep(clock_id, flags, &sleepfor, &unslept) == 0) { RETVAL = nsec; @@ -1465,16 +2040,16 @@ clock_nanosleep(clock_id, nsec, flags = 0) #else /* if defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME) */ -NV +NV_DIE clock_nanosleep(clock_id, nsec, flags = 0) - clockid_t clock_id - NV nsec - int flags + clockid_t die_t clock_id + NV_DIE nsec + int die_t flags CODE: PERL_UNUSED_ARG(clock_id); PERL_UNUSED_ARG(nsec); PERL_UNUSED_ARG(flags); - croak("Time::HiRes::clock_nanosleep(): unimplemented in this platform"); + croak_xs_unimplemented(cv); RETVAL = 0.0; OUTPUT: RETVAL @@ -1496,10 +2071,10 @@ clock() #else /* if defined(TIME_HIRES_CLOCK) && defined(CLOCKS_PER_SEC) */ -NV +NV_DIE clock() CODE: - croak("Time::HiRes::clock(): unimplemented in this platform"); + croak_xs_unimplemented(cv); RETVAL = 0.0; OUTPUT: RETVAL @@ -1510,39 +2085,57 @@ void stat(...) PROTOTYPE: ;$ PREINIT: - OP fakeop; - int nret; + SSize_t nret; + SV* sv_arg; + SV** SPBASE; + U32 op_type = (U32)ix; ALIAS: - Time::HiRes::lstat = 1 + Time::HiRes::stat = OP_STAT + Time::HiRes::lstat = OP_LSTAT PPCODE: - XPUSHs(sv_2mortal(newSVsv(items == 1 ? ST(0) : DEFSV))); + EXTEND(SP, 13); + sv_arg = items == 1 ? ST(0) : DEFSV; + /* XXX will pp_stat()/pp_lstat() really modify $_[0] ? */ + PUSHs(sv_2mortal(THR_newSVsv_cow(sv_arg))); PUTBACK; ENTER; PL_laststatval = -1; SAVEOP(); - Zero(&fakeop, 1, OP); - fakeop.op_type = ix ? OP_LSTAT : OP_STAT; - fakeop.op_ppaddr = PL_ppaddr[fakeop.op_type]; - fakeop.op_flags = GIMME_V == G_LIST ? OPf_WANT_LIST : - GIMME_V == G_SCALAR ? OPf_WANT_SCALAR : OPf_WANT_VOID; - PL_op = &fakeop; - (void)fakeop.op_ppaddr(aTHX); - SPAGAIN; + { + OP* (*ppaddr)(pTHX); + U8 gimme = GIMME_V; /* ILP */ +/* extern "C" memset() doesn't know struct OP's alignment. ISO C doesn't + promise Zero(); and memset(); will inline. But this does. Now the CC can + detangle for us, what OP fields will get a 0/NULL, or our values. */ + OP fakeop = {0}; + fakeop.op_flags = gimme == G_LIST ? OPf_WANT_LIST : + gimme == G_SCALAR ? OPf_WANT_SCALAR : OPf_WANT_VOID; /* ILP */ + ppaddr = PL_ppaddr[op_type]; + fakeop.op_type = (U16)op_type; + fakeop.op_ppaddr = ppaddr; /* ILP */ + PL_op = &fakeop; + (void)ppaddr(aTHX); + } LEAVE; - nret = SP+1 - &ST(0); + SPAGAIN; + SPBASE = &ST(0); + nret = SP+1 - SPBASE; if (nret == 13) { - UV atime = SvUV(ST( 8)); - UV mtime = SvUV(ST( 9)); - UV ctime = SvUV(ST(10)); UV atime_nsec; UV mtime_nsec; UV ctime_nsec; hrstatns(&atime_nsec, &mtime_nsec, &ctime_nsec); - if (atime_nsec) - ST( 8) = sv_2mortal(newSVnv(atime + (NV) atime_nsec / NV_1E9)); - if (mtime_nsec) - ST( 9) = sv_2mortal(newSVnv(mtime + (NV) mtime_nsec / NV_1E9)); - if (ctime_nsec) - ST(10) = sv_2mortal(newSVnv(ctime + (NV) ctime_nsec / NV_1E9)); + if (atime_nsec) { /* on certain configs hrstatns() is a NOOP */ + UV atime = SvUV(SPBASE[ 8]); + SPBASE[ 8] = sv_2mortal(newSVnv(atime + (NV) atime_nsec / NV_1E9)); + } + if (mtime_nsec) { + UV mtime = SvUV(SPBASE[ 9]); + SPBASE[ 9] = sv_2mortal(newSVnv(mtime + (NV) mtime_nsec / NV_1E9)); + } + if (ctime_nsec) { + UV ctime = SvUV(SPBASE[10]); + SPBASE[10] = sv_2mortal(newSVnv(ctime + (NV) ctime_nsec / NV_1E9)); + } } XSRETURN(nret); diff --git a/dist/Time-HiRes/Makefile.PL b/dist/Time-HiRes/Makefile.PL index ac56d8df2795..dc7c2f5401db 100644 --- a/dist/Time-HiRes/Makefile.PL +++ b/dist/Time-HiRes/Makefile.PL @@ -1015,6 +1015,14 @@ sub doConstants { push @names, {name => $_, macro => $macro, value => 1, default => ["IV", "0"]}; } + { + #disarm chopping off first or last letter of each C string for memEQs() + my $sub = \&ExtUtils::Constant::Base::memEQ_clause; + *ExtUtils::Constant::Base::memEQ_clause = sub { + $_[1]->{checked_at} = 32; + return $sub->(@_); + }; + } ExtUtils::Constant::WriteConstants( NAME => 'Time::HiRes', NAMES => \@names, diff --git a/dist/Time-HiRes/t/clock.t b/dist/Time-HiRes/t/clock.t index 810d63a272fe..ad5f728970bb 100644 --- a/dist/Time-HiRes/t/clock.t +++ b/dist/Time-HiRes/t/clock.t @@ -1,11 +1,54 @@ use strict; -use Test::More tests => 5; +use Test::More tests => 6; BEGIN { push @INC, '.' } use t::Watchdog; BEGIN { require_ok "Time::HiRes"; } + +my @EXPORT_OK_valid = qw (usleep sleep ualarm alarm gettimeofday time tv_interval + getitimer setitimer nanosleep clock_gettime clock_getres + clock clock_nanosleep + CLOCKS_PER_SEC + CLOCK_BOOTTIME + CLOCK_HIGHRES + CLOCK_MONOTONIC + CLOCK_MONOTONIC_COARSE + CLOCK_MONOTONIC_FAST + CLOCK_MONOTONIC_PRECISE + CLOCK_MONOTONIC_RAW + CLOCK_PROCESS_CPUTIME_ID + CLOCK_PROF + CLOCK_REALTIME + CLOCK_REALTIME_COARSE + CLOCK_REALTIME_FAST + CLOCK_REALTIME_PRECISE + CLOCK_REALTIME_RAW + CLOCK_SECOND + CLOCK_SOFTTIME + CLOCK_THREAD_CPUTIME_ID + CLOCK_TIMEOFDAY + CLOCK_UPTIME + CLOCK_UPTIME_COARSE + CLOCK_UPTIME_FAST + CLOCK_UPTIME_PRECISE + CLOCK_UPTIME_RAW + CLOCK_VIRTUAL + ITIMER_PROF + ITIMER_REAL + ITIMER_REALPROF + ITIMER_VIRTUAL + TIMER_ABSTIME + d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer + d_nanosleep d_clock_gettime d_clock_getres + d_clock d_clock_nanosleep d_hires_stat + d_futimens d_utimensat d_hires_utime + stat lstat utime + ); + +is_deeply(\@Time::HiRes::EXPORT_OK, \@EXPORT_OK_valid, '@Time::HiRes::EXPORT_OK has correct strings'); + sub has_symbol { my $symbol = shift; eval "use Time::HiRes qw($symbol)"; diff --git a/dist/Time-HiRes/typemap b/dist/Time-HiRes/typemap index 2772c92582e8..f06b500bb6f7 100644 --- a/dist/Time-HiRes/typemap +++ b/dist/Time-HiRes/typemap @@ -1,5 +1,6 @@ # basic C types int T_IV +int die_t T_IV_DIE unsigned T_UV unsigned int T_UV long T_IV @@ -29,11 +30,14 @@ HV * T_HVREF CV * T_CVREF clockid_t T_IV +clockid_t die_t T_IV_DIE IV T_IV UV T_UV NV T_NV +NV_DIE T_NV_DIE I32 T_IV +I32_DIE T_IV_DIE I16 T_IV I8 T_IV STRLEN T_UV @@ -84,6 +88,8 @@ T_UV $var = ($type)SvUV($arg) T_IV $var = ($type)SvIV($arg) +T_IV_DIE + $var = ($type)0 T_INT $var = (int)SvIV($arg) T_ENUM @@ -108,6 +114,8 @@ T_FLOAT $var = (float)SvNV($arg) T_NV $var = ($type)SvNV($arg) +T_NV_DIE + $var = ($type)0 T_DOUBLE $var = (double)SvNV($arg) T_PV @@ -205,6 +213,8 @@ T_CVREF $arg = newRV((SV*)$var); T_IV sv_setiv($arg, (IV)$var); +T_IV_DIE + croak_xs_usage(cv, "T_IV_DIE"); T_UV sv_setuv($arg, (UV)$var); T_INT @@ -238,6 +248,8 @@ T_FLOAT sv_setnv($arg, (double)$var); T_NV sv_setnv($arg, (NV)$var); +T_NV_DIE + croak_xs_usage(cv, "T_NV_DIE"); T_DOUBLE sv_setnv($arg, (double)$var); T_PV diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm index 35d4c34e8b3b..9543147488f8 100644 --- a/ext/XS-APItest/APItest.pm +++ b/ext/XS-APItest/APItest.pm @@ -4,7 +4,7 @@ use strict; use warnings; use Carp; -our $VERSION = '1.42'; +our $VERSION = '1.43'; require XSLoader; diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index dd3e7dcfdc3b..daf5332df49a 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -1593,6 +1593,121 @@ XSPP_wrapped(my_pp_anonlist, 0, 1) RETURN; } +static NV (*myNVtime)() = NULL; +static NV (*myNVtime_cxt)(pTHX) = NULL; +static void (*myU2time)(pTHX_ UV ret[2]) = NULL; + +#if defined(MULTIPLICITY) && !defined(PERL_NO_GET_CONTEXT) && !defined(PERL_CORE) +# undef aTHX +# undef aTHX_ +# define aTHX my_perl +# define aTHX_ aTHX, +#endif + +XS_INTERNAL(XS__APItest__XSUB_XS_APIVERSION_Time_HiRes_Init) +{ + dVAR; dXSARGS; + if (items != 0) + croak_xs_usage(cv, ""); + PERL_UNUSED_VAR(ax); /* -Wall */ + { + HV* modglobal = PL_modglobal; + SV **svp = hv_fetchs(modglobal, "Time::NVtime", 0); + SV* sv; + if (!svp) + croak("Time::HiRes is required"); + sv = *svp; + if (!SvIOK(sv) || !SvIVX(sv)) + croak("Time::NVtime isn't a function pointer"); + myNVtime = INT2PTR(NV(*)(), SvIVX(sv)); + if (!SvPOK(sv) || SvCUR(sv) != sizeof(void*) || SvPVX(sv) == NULL + || *((void**)SvPVX(sv)) == NULL) + croak("Time::NVtime_cxt isn't a function pointer"); + else + myNVtime_cxt = INT2PTR(NV(*)(pTHX), *((void**)SvPVX(sv))); + + svp = hv_fetchs(modglobal, "Time::U2time", 0); + if (!svp) + croak("Time::HiRes is required"); + sv = *svp; + if (!SvIOK(sv) || !SvIVX(sv)) + croak("Time::U2time isn't a function pointer"); + myU2time = INT2PTR(void(*)(pTHX_ UV ret[2]), SvIVX(sv)); + } + XSRETURN_YES; +} + +XS_INTERNAL(XS__APItest__XSUB_XS_APIVERSION_Time_HiRes_myNVtime) +{ + dVAR; dXSARGS; + if (items != 0) + croak_xs_usage(cv, ""); + PERL_UNUSED_VAR(ax); /* -Wall */ + { + dXSTARG; + PUSHs(TARG); + PUTBACK; + { + NV nv = myNVtime(); + TARGn(nv,1); + } + } + return; +} + +XS_INTERNAL(XS__APItest__XSUB_XS_APIVERSION_Time_HiRes_myNVtime_cxt) +{ + dVAR; dXSARGS; + if (items != 0) + croak_xs_usage(cv, ""); + PERL_UNUSED_VAR(ax); /* -Wall */ + { + SV* TARG; + SV* TARG2; + if(GIMME_V != G_LIST) { + dXSTARG; + TARG2 = TARG; + } + TARG = TARG2; + PUSHs(TARG); + PUTBACK; + { + NV nv = myNVtime_cxt(aTHX); + TARGn(nv,1); + } + } + return; +} + +XS_INTERNAL(XS__APItest__XSUB_XS_APIVERSION_Time_HiRes_myU2time) +{ + dVAR; + dXSARGS; + EXTEND(SP, 2); + if (items != 0) + croak_xs_usage(cv, ""); + PERL_UNUSED_VAR(ax); /* -Wall */ + { + dXSTARG; + UV ret[2]; + SV* sv2; + PUSHs(TARG); + sv2 = sv_2mortal(newSVuv(0)); + PUSHs(sv2); + PUTBACK; + myU2time(aTHX_ ret); + TARGu(ret[0],1); + SvUV_set(sv2, ret[1]); + } + return; +} + +#if defined(MULTIPLICITY) && !defined(PERL_NO_GET_CONTEXT) && !defined(PERL_CORE) +# undef aTHX +# undef aTHX_ +# define aTHX PERL_GET_THX +# define aTHX_ aTHX, +#endif #include "const-c.inc" @@ -1873,6 +1988,11 @@ BOOT: newXS("XS::APItest::XSUB::XS_VERSION_undef", XS_XS__APItest__XSUB_XS_VERSION_undef, __FILE__); newXS("XS::APItest::XSUB::XS_VERSION_empty", XS_XS__APItest__XSUB_XS_VERSION_empty, __FILE__); newXS("XS::APItest::XSUB::XS_APIVERSION_invalid", XS_XS__APItest__XSUB_XS_APIVERSION_invalid, __FILE__); + newXS("XS::APItest::XSUB::Time::HiRes::Init", XS__APItest__XSUB_XS_APIVERSION_Time_HiRes_Init, __FILE__); + newXS("XS::APItest::XSUB::Time::HiRes::myNVtime", XS__APItest__XSUB_XS_APIVERSION_Time_HiRes_myNVtime, __FILE__); + newXS("XS::APItest::XSUB::Time::HiRes::myNVtime_cxt", XS__APItest__XSUB_XS_APIVERSION_Time_HiRes_myNVtime_cxt, __FILE__); + newXS("XS::APItest::XSUB::Time::HiRes::myU2time", XS__APItest__XSUB_XS_APIVERSION_Time_HiRes_myU2time , __FILE__); + void XS_VERSION_defined(...) diff --git a/ext/XS-APItest/t/xsub_h.t b/ext/XS-APItest/t/xsub_h.t index a7e2541e425f..cf0b3bc9fce2 100644 --- a/ext/XS-APItest/t/xsub_h.t +++ b/ext/XS-APItest/t/xsub_h.t @@ -4,6 +4,7 @@ use strict; use Test::More; BEGIN { use_ok('XS::APItest') }; +BEGIN { use_ok('Time::HiRes') }; our ($XS_VERSION, $VERSION); @@ -150,5 +151,18 @@ is scalar @xs_empty, 0, 'XSRETURN_EMPTY returns empty list in array context'; my $xs_empty = XS::APItest::XSUB::xsreturn_empty(); is $xs_empty, undef, 'XSRETURN_EMPTY returns undef in scalar context'; +{ + ok(XS::APItest::XSUB::Time::HiRes::Init(), "XS::APItest::XSUB::Time::HiRes::Init"); + my $num = XS::APItest::XSUB::Time::HiRes::myNVtime(); + ok($num && $num != -1.0 && int($num) != -1, "XS::APItest::XSUB::Time::HiRes::myNVtime true"); + $num = XS::APItest::XSUB::Time::HiRes::myNVtime_cxt(); + ok($num && $num != -1.0 && int($num) != -1, "XS::APItest::XSUB::Time::HiRes::myNVtime_cxt true"); + $num = [XS::APItest::XSUB::Time::HiRes::myU2time()]; + ok(scalar(@{$num}) == 2, "XS::APItest::XSUB::Time::HiRes::myNVtime_cxt 2 element array"); + ok($num->[0] && $num->[0] != -1, "XS::APItest::XSUB::Time::HiRes::myNVtime_cxt array[0] true"); + ok($num->[1] && $num->[1] != -1, "XS::APItest::XSUB::Time::HiRes::myNVtime_cxt array[1] true"); + ok(!defined($num->[2]), "XS::APItest::XSUB::Time::HiRes::myNVtime_cxt array[2] is undef"); +} + done_testing();