Skip to content

Commit 35df764

Browse files
bulk88bulk88
committed
Time::HiRes add fast no dTHX; myNVtime() variant for CPAN XS devs (exprmt)
-TMHR has a fancy Perl maintained Win32 high precision GTOD() polyfill impl inside it. But it can't be used for actual benchmarking by CPAN authors b/c it's do a very slow Perl_get_context() call every time to get access to MY_CXT struct. So add a pTHX_ version of myNVtime(). Add tests that prove TMHR's C level public API for CPAN authors actually exists and works. Nothing inside the P5P repo, ever tries to use TMHR's C level Time::HiRes::myNVtime / Time::HiRes::myU2time function pointers. -The 3 XSUBs for calling the TMHR C func ptrs, really should be in a new .xs file inside ext/XS-APItest/ called "benchmark.xs" or "noplgetcxt.xs" that has #define NO_PERL_GET_CONTEXT at the top, UNLIKE all the other XS-APItest .xs files, which try to prove the very slot ithreads-unaware CPAN XS legacy src code compat mode actually works. -POK and SvPVX() store the 2nd fn ptr, in the same SV*, POK flag can be used by CPAN XS authors to separate old TMHR releases w/o the new fn ptr from new TMHR releases that have it. NOK and SvNVX() and using union _xnvu { NV xnv_nv; HV * xgv_stash; <<<<<<<< line_t xnv_lines; bool xnv_bm_tail; }; is an alternative design, but I went with POK and SvPVX, because even with SvREADONLY(), I have paranoia, some C code on some OS on some CPU arch somewhere, will do a random read -> round_and_or_fire_IEEE_OS_signals -> write to SvNVX() operation on the SvNVX() slot, for no good reason, b/c of academic purity/standards body compliance/ABI requirements of that CPU/OS arch, and the function ptr is now giberish, or was converted from a denormal NaN to a normal NaN or SIG_DIV0-ed. -future expansion provision exists, if SvPOK_on && SvCUR() > sizeof(void*), SvPVX() is now a pointer to a C struct/C array, with the 1st 4/8 bytes being a header, and not a fn ptr. -TODO return by copy version of Time::U2time fn ptr, more efficient on certain ABIs (__vectorcall/SysV) that allow 128 bit structs/arrays to be returned in 2 registers back to the caller, and not secret pointers as a secret 1st arg
1 parent 87c3bfb commit 35df764

File tree

3 files changed

+174
-3
lines changed

3 files changed

+174
-3
lines changed

‎dist/Time-HiRes/HiRes.xs

Lines changed: 40 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -671,18 +671,38 @@ myU2time(pTHX_ UV *ret)
671671
return status;
672672
}
673673

674+
#ifdef PERL_IMPLICIT_CONTEXT
675+
static NV myNVtime_cxt(pTHX);
676+
#endif
677+
674678
static NV
675679
myNVtime()
676680
{
677681
# ifdef WIN32
678682
dTHX;
683+
# ifdef PERL_IMPLICIT_CONTEXT
684+
return myNVtime_cxt(aTHX);
685+
# endif
679686
# endif
680687
struct timeval Tp;
681688
int status;
682689
status = gettimeofday (&Tp, NULL);
683690
return status == 0 ? Tp.tv_sec + (Tp.tv_usec / NV_1E6) : -1.0;
684691
}
685692

693+
#ifdef PERL_IMPLICIT_CONTEXT
694+
695+
static NV
696+
myNVtime_cxt(pTHX)
697+
{
698+
struct timeval Tp;
699+
int status;
700+
status = gettimeofday (&Tp, NULL);
701+
return status == 0 ? Tp.tv_sec + (Tp.tv_usec / NV_1E6) : -1.0;
702+
}
703+
704+
#endif
705+
686706
#endif /* #ifdef HAS_GETTIMEOFDAY */
687707

688708
/* Force inline this because it has only 1 caller:
@@ -1050,9 +1070,26 @@ BOOT:
10501070
#endif
10511071
#ifdef HAS_GETTIMEOFDAY
10521072
{
1053-
HV* const modglobal = PL_modglobal;
1054-
(void)hv_stores(modglobal, "Time::NVtime", newSViv(PTR2IV(myNVtime)));
1055-
(void)hv_stores(modglobal, "Time::U2time", newSViv(PTR2IV(myU2time)));
1073+
SV* sv = newSV_type(SVt_PVIV);
1074+
#ifdef PERL_IMPLICIT_CONTEXT
1075+
const static NV (* const pMyNVtime_cxt)(pTHX) = myNVtime_cxt;
1076+
#else
1077+
const static NV (* const pMyNVtime_cxt)(pTHX) = myNVtime;
1078+
#endif
1079+
/* Don't bother making a 5/9 byte struct{void*; char;} just for '\0'.
1080+
It is 8/16 bytes after padding. This SVPV will never be "printed". */
1081+
SvCUR_set(sv, sizeof(pMyNVtime_cxt));
1082+
SvLEN_set(sv, 0);
1083+
SvIV_set(sv, PTR2IV(myNVtime));
1084+
SvPV_set(sv, (char *)(&pMyNVtime_cxt));
1085+
SvPOK_on(sv);
1086+
SvIOK_on(sv);
1087+
SvREADONLY_on(sv);
1088+
{
1089+
HV* const modglobal = PL_modglobal;
1090+
(void)hv_stores(modglobal, "Time::NVtime", sv);
1091+
(void)hv_stores(modglobal, "Time::U2time", newSViv(PTR2IV(myU2time)));
1092+
}
10561093
}
10571094
#endif
10581095
#if defined(PERL_DARWIN)

‎ext/XS-APItest/APItest.xs

Lines changed: 120 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1593,6 +1593,121 @@ XSPP_wrapped(my_pp_anonlist, 0, 1)
15931593
RETURN;
15941594
}
15951595

1596+
static NV (*myNVtime)() = NULL;
1597+
static NV (*myNVtime_cxt)(pTHX) = NULL;
1598+
static void (*myU2time)(pTHX_ UV ret[2]) = NULL;
1599+
1600+
#if defined(MULTIPLICITY) && !defined(PERL_NO_GET_CONTEXT) && !defined(PERL_CORE)
1601+
# undef aTHX
1602+
# undef aTHX_
1603+
# define aTHX my_perl
1604+
# define aTHX_ aTHX,
1605+
#endif
1606+
1607+
XS_INTERNAL(XS__APItest__XSUB_XS_APIVERSION_Time_HiRes_Init)
1608+
{
1609+
dVAR; dXSARGS;
1610+
if (items != 0)
1611+
croak_xs_usage(cv, "");
1612+
PERL_UNUSED_VAR(ax); /* -Wall */
1613+
{
1614+
HV* modglobal = PL_modglobal;
1615+
SV **svp = hv_fetchs(modglobal, "Time::NVtime", 0);
1616+
SV* sv;
1617+
if (!svp)
1618+
croak("Time::HiRes is required");
1619+
sv = *svp;
1620+
if (!SvIOK(sv) || !SvIVX(sv))
1621+
croak("Time::NVtime isn't a function pointer");
1622+
myNVtime = INT2PTR(NV(*)(), SvIVX(sv));
1623+
if (!SvPOK(sv) || SvCUR(sv) != sizeof(void*) || SvPVX(sv) == NULL
1624+
|| *((void**)SvPVX(sv)) == NULL)
1625+
croak("Time::NVtime_cxt isn't a function pointer");
1626+
else
1627+
myNVtime_cxt = INT2PTR(NV(*)(pTHX), *((void**)SvPVX(sv)));
1628+
1629+
svp = hv_fetchs(modglobal, "Time::U2time", 0);
1630+
if (!svp)
1631+
croak("Time::HiRes is required");
1632+
sv = *svp;
1633+
if (!SvIOK(sv) || !SvIVX(sv))
1634+
croak("Time::U2time isn't a function pointer");
1635+
myU2time = INT2PTR(void(*)(pTHX_ UV ret[2]), SvIVX(sv));
1636+
}
1637+
XSRETURN_YES;
1638+
}
1639+
1640+
XS_INTERNAL(XS__APItest__XSUB_XS_APIVERSION_Time_HiRes_myNVtime)
1641+
{
1642+
dVAR; dXSARGS;
1643+
if (items != 0)
1644+
croak_xs_usage(cv, "");
1645+
PERL_UNUSED_VAR(ax); /* -Wall */
1646+
{
1647+
dXSTARG;
1648+
PUSHs(TARG);
1649+
PUTBACK;
1650+
{
1651+
NV nv = myNVtime();
1652+
TARGn(nv,1);
1653+
}
1654+
}
1655+
return;
1656+
}
1657+
1658+
XS_INTERNAL(XS__APItest__XSUB_XS_APIVERSION_Time_HiRes_myNVtime_cxt)
1659+
{
1660+
dVAR; dXSARGS;
1661+
if (items != 0)
1662+
croak_xs_usage(cv, "");
1663+
PERL_UNUSED_VAR(ax); /* -Wall */
1664+
{
1665+
SV* TARG;
1666+
SV* TARG2;
1667+
if(GIMME_V != G_LIST) {
1668+
dXSTARG;
1669+
TARG2 = TARG;
1670+
}
1671+
TARG = TARG2;
1672+
PUSHs(TARG);
1673+
PUTBACK;
1674+
{
1675+
NV nv = myNVtime_cxt(aTHX);
1676+
TARGn(nv,1);
1677+
}
1678+
}
1679+
return;
1680+
}
1681+
1682+
XS_INTERNAL(XS__APItest__XSUB_XS_APIVERSION_Time_HiRes_myU2time)
1683+
{
1684+
dVAR;
1685+
dXSARGS;
1686+
EXTEND(SP, 2);
1687+
if (items != 0)
1688+
croak_xs_usage(cv, "");
1689+
PERL_UNUSED_VAR(ax); /* -Wall */
1690+
{
1691+
dXSTARG;
1692+
UV ret[2];
1693+
SV* sv2;
1694+
PUSHs(TARG);
1695+
sv2 = sv_2mortal(newSVuv(0));
1696+
PUSHs(sv2);
1697+
PUTBACK;
1698+
myU2time(aTHX_ ret);
1699+
TARGu(ret[0],1);
1700+
SvUV_set(sv2, ret[1]);
1701+
}
1702+
return;
1703+
}
1704+
1705+
#if defined(MULTIPLICITY) && !defined(PERL_NO_GET_CONTEXT) && !defined(PERL_CORE)
1706+
# undef aTHX
1707+
# undef aTHX_
1708+
# define aTHX PERL_GET_THX
1709+
# define aTHX_ aTHX,
1710+
#endif
15961711

15971712
#include "const-c.inc"
15981713

@@ -1873,6 +1988,11 @@ BOOT:
18731988
newXS("XS::APItest::XSUB::XS_VERSION_undef", XS_XS__APItest__XSUB_XS_VERSION_undef, __FILE__);
18741989
newXS("XS::APItest::XSUB::XS_VERSION_empty", XS_XS__APItest__XSUB_XS_VERSION_empty, __FILE__);
18751990
newXS("XS::APItest::XSUB::XS_APIVERSION_invalid", XS_XS__APItest__XSUB_XS_APIVERSION_invalid, __FILE__);
1991+
newXS("XS::APItest::XSUB::Time::HiRes::Init", XS__APItest__XSUB_XS_APIVERSION_Time_HiRes_Init, __FILE__);
1992+
newXS("XS::APItest::XSUB::Time::HiRes::myNVtime", XS__APItest__XSUB_XS_APIVERSION_Time_HiRes_myNVtime, __FILE__);
1993+
newXS("XS::APItest::XSUB::Time::HiRes::myNVtime_cxt", XS__APItest__XSUB_XS_APIVERSION_Time_HiRes_myNVtime_cxt, __FILE__);
1994+
newXS("XS::APItest::XSUB::Time::HiRes::myU2time", XS__APItest__XSUB_XS_APIVERSION_Time_HiRes_myU2time , __FILE__);
1995+
18761996

18771997
void
18781998
XS_VERSION_defined(...)

‎ext/XS-APItest/t/xsub_h.t

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@ use strict;
44
use Test::More;
55

66
BEGIN { use_ok('XS::APItest') };
7+
BEGIN { use_ok('Time::HiRes') };
78

89
our ($XS_VERSION, $VERSION);
910

@@ -150,5 +151,18 @@ is scalar @xs_empty, 0, 'XSRETURN_EMPTY returns empty list in array context';
150151
my $xs_empty = XS::APItest::XSUB::xsreturn_empty();
151152
is $xs_empty, undef, 'XSRETURN_EMPTY returns undef in scalar context';
152153

154+
{
155+
ok(XS::APItest::XSUB::Time::HiRes::Init(), "XS::APItest::XSUB::Time::HiRes::Init");
156+
my $num = XS::APItest::XSUB::Time::HiRes::myNVtime();
157+
ok($num && $num != -1.0 && int($num) != -1, "XS::APItest::XSUB::Time::HiRes::myNVtime true");
158+
$num = XS::APItest::XSUB::Time::HiRes::myNVtime_cxt();
159+
ok($num && $num != -1.0 && int($num) != -1, "XS::APItest::XSUB::Time::HiRes::myNVtime_cxt true");
160+
$num = [XS::APItest::XSUB::Time::HiRes::myU2time()];
161+
ok(scalar(@{$num}) == 2, "XS::APItest::XSUB::Time::HiRes::myNVtime_cxt 2 element array");
162+
ok($num->[0] && $num->[0] != -1, "XS::APItest::XSUB::Time::HiRes::myNVtime_cxt array[0] true");
163+
ok($num->[1] && $num->[1] != -1, "XS::APItest::XSUB::Time::HiRes::myNVtime_cxt array[1] true");
164+
ok(!defined($num->[2]), "XS::APItest::XSUB::Time::HiRes::myNVtime_cxt array[2] is undef");
165+
}
166+
153167

154168
done_testing();

0 commit comments

Comments
 (0)