summaryrefslogtreecommitdiff
path: root/pp.c
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2015-10-22 12:04:40 +0100
committerDavid Mitchell <davem@iabyn.com>2015-11-10 13:52:34 +0000
commit230ee21f3e366901ce5769d324124c522df7ce8a (patch)
treefd772e2d8d5d940426b6037f163500cc7ee89dfe /pp.c
parentedba15b0ccf22f00ea6d7cc58eb2c173437a09cc (diff)
downloadperl-230ee21f3e366901ce5769d324124c522df7ce8a.tar.gz
faster add, subtract, multiply
In pp_add, pp_subtract and pp_multiply, special-case the following: * both args IV, neither arg large enough to under/overflow * both args NV. Starting in 5.8.0, the implementation of the arithmetic pp functions became a lot more complex (and famously, much slower), due to the need to support 64-bit integers. For example, formerly pp_add just converted both its args to an NV and returned an NV. On 64-bit systems, that could gave bad results if the mantissa of an NV was < 64 bits; for example: $ perl561 -e'$x = 0x1000000000000000; printf "%x\n", $x+1' 1000000000000000 $ perl580 -e'$x = 0x1000000000000000; printf "%x\n", $x+1' 1000000000000001 This led to a lot of complex code that covered all the possibilities of overflow etc. This commit adds some special casing to these three common arithmetic ops. It does some quick checks (mainly involving fast boolean and bit ops) to determine if both args are valid IVs (and not UVs), are not magic, and aren't very big (+ve or -ve). In this case, the result is simply SvIVX(svl) + SvIVX(svr) (or - or *) with no possibility of overflow. Failing that, if both args are NV's and not magic, then if both NVs can be converted to IVs without loss, handle as for the IV case; failing that, just return SvNVX(svl) + SvNVX(svr); For all other cases, such as mixed IV and NV or PV, fall back to the old code. On my platform (x86_64), it (along with the previous commit) reduces the execution time of the nbody benchmark (lots of floating-point vector arithmetic) by a third and in fact makes it 10% faster than 5.6.1.
Diffstat (limited to 'pp.c')
-rw-r--r--pp.c119
1 files changed, 110 insertions, 9 deletions
diff --git a/pp.c b/pp.c
index b084d4949c..2305bbd72b 100644
--- a/pp.c
+++ b/pp.c
@@ -1276,7 +1276,64 @@ PP(pp_multiply)
tryAMAGICbin_MG(mult_amg, AMGf_assign|AMGf_numeric);
svr = TOPs;
svl = TOPm1s;
+
#ifdef PERL_PRESERVE_IVUV
+
+ /* special-case some simple common cases */
+ if (!((svl->sv_flags|svr->sv_flags) & (SVf_IVisUV|SVs_GMG))) {
+ IV il, ir;
+ U32 flags = (svl->sv_flags & svr->sv_flags);
+ if (flags & SVf_IOK) {
+ /* both args are simple IVs */
+ UV topl, topr;
+ il = SvIVX(svl);
+ ir = SvIVX(svr);
+ do_iv:
+ topl = ((UV)il) >> (UVSIZE * 4 - 1);
+ topr = ((UV)ir) >> (UVSIZE * 4 - 1);
+
+ /* if both are in a range that can't under/overflow, do a
+ * simple integer multiply: if the top halves(*) of both numbers
+ * are 00...00 or 11...11, then it's safe.
+ * (*) for 32-bits, the "top half" is the top 17 bits,
+ * for 64-bits, its 33 bits */
+ if (!(
+ ((topl+1) | (topr+1))
+ & ( (((UV)1) << (UVSIZE * 4 + 1)) - 2) /* 11..110 */
+ )) {
+ SP--;
+ TARGi(il * ir, 0); /* args not GMG, so can't be tainted */
+ SETs(TARG);
+ RETURN;
+ }
+ goto generic;
+ }
+ else if (flags & SVf_NOK) {
+ /* both args are NVs */
+ NV nl = SvNVX(svl);
+ NV nr = SvNVX(svr);
+ NV result;
+
+ il = (IV)nl;
+ ir = (IV)nr;
+ if (nl == (NV)il && nr == (NV)ir)
+ /* nothing was lost by converting to IVs */
+ goto do_iv;
+ SP--;
+ result = nl * nr;
+# if defined(__sgi) && defined(USE_LONG_DOUBLE) && LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN && NVSIZE == 16
+ if (Perl_isinf(result)) {
+ Zero((U8*)&result + 8, 8, U8);
+ }
+# endif
+ TARGn(result, 0); /* args not GMG, so can't be tainted */
+ SETs(TARG);
+ RETURN;
+ }
+ }
+
+ generic:
+
if (SvIV_please_nomg(svr)) {
/* Unless the left argument is integer in range we are going to have to
use NV maths. Hence only attempt to coerce the right argument if
@@ -1393,18 +1450,15 @@ PP(pp_multiply)
{
NV right = SvNV_nomg(svr);
NV left = SvNV_nomg(svl);
+ NV result = left * right;
+
(void)POPs;
#if defined(__sgi) && defined(USE_LONG_DOUBLE) && LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN && NVSIZE == 16
- {
- NV result = left * right;
- if (Perl_isinf(result)) {
- Zero((U8*)&result + 8, 8, U8);
- }
- SETn( result );
+ if (Perl_isinf(result)) {
+ Zero((U8*)&result + 8, 8, U8);
}
-#else
- SETn( left * right );
#endif
+ SETn(result);
RETURN;
}
}
@@ -1804,8 +1858,53 @@ PP(pp_subtract)
tryAMAGICbin_MG(subtr_amg, AMGf_assign|AMGf_numeric);
svr = TOPs;
svl = TOPm1s;
- useleft = USE_LEFT(svl);
+
#ifdef PERL_PRESERVE_IVUV
+
+ /* special-case some simple common cases */
+ if (!((svl->sv_flags|svr->sv_flags) & (SVf_IVisUV|SVs_GMG))) {
+ IV il, ir;
+ U32 flags = (svl->sv_flags & svr->sv_flags);
+ if (flags & SVf_IOK) {
+ /* both args are simple IVs */
+ UV topl, topr;
+ il = SvIVX(svl);
+ ir = SvIVX(svr);
+ do_iv:
+ topl = ((UV)il) >> (UVSIZE * 8 - 2);
+ topr = ((UV)ir) >> (UVSIZE * 8 - 2);
+
+ /* if both are in a range that can't under/overflow, do a
+ * simple integer subtract: if the top of both numbers
+ * are 00 or 11, then it's safe */
+ if (!( ((topl+1) | (topr+1)) & 2)) {
+ SP--;
+ TARGi(il - ir, 0); /* args not GMG, so can't be tainted */
+ SETs(TARG);
+ RETURN;
+ }
+ goto generic;
+ }
+ else if (flags & SVf_NOK) {
+ /* both args are NVs */
+ NV nl = SvNVX(svl);
+ NV nr = SvNVX(svr);
+
+ il = (IV)nl;
+ ir = (IV)nr;
+ if (nl == (NV)il && nr == (NV)ir)
+ /* nothing was lost by converting to IVs */
+ goto do_iv;
+ SP--;
+ TARGn(nl - nr, 0); /* args not GMG, so can't be tainted */
+ SETs(TARG);
+ RETURN;
+ }
+ }
+
+ generic:
+
+ useleft = USE_LEFT(svl);
/* See comments in pp_add (in pp_hot.c) about Overflow, and how
"bad things" happen if you rely on signed integers wrapping. */
if (SvIV_please_nomg(svr)) {
@@ -1903,6 +2002,8 @@ PP(pp_subtract)
} /* Overflow, drop through to NVs. */
}
}
+#else
+ useleft = USE_LEFT(svl);
#endif
{
NV value = SvNV_nomg(svr);