From 3a019afd6f6291c3249c254b5c01e244e4ec83ab Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 28 Apr 2019 17:42:44 -0600 Subject: [PATCH 1/3] Create fcn for lossless conversion of NV to IV MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Essentially the same code was being used in three places, and had undefined C behavior for some inputs. This consolidates the code into one inline function, and rewrites it to avoid undefined behavior. Signed-off-by: Petr Písař --- embed.fnc | 1 + embed.h | 3 +++ inline.h | 34 ++++++++++++++++++++++++++++++++++ pp.c | 20 ++++---------------- pp_hot.c | 10 ++-------- proto.h | 7 +++++++ 6 files changed, 51 insertions(+), 24 deletions(-) diff --git a/embed.fnc b/embed.fnc index 45597f67b6..259affded0 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2272,6 +2272,7 @@ sR |SV* |refto |NN SV* sv : Used in pp_hot.c pRxo |GV* |softref2xv |NN SV *const sv|NN const char *const what \ |const svtype type|NN SV ***spp +inR |bool |lossless_NV_to_IV|const NV nv|NN IV * ivp #endif #if defined(PERL_IN_PP_PACK_C) diff --git a/embed.h b/embed.h index 75c91f77f4..9178c51e92 100644 --- a/embed.h +++ b/embed.h @@ -1924,6 +1924,9 @@ #define do_delete_local() S_do_delete_local(aTHX) #define refto(a) S_refto(aTHX_ a) # endif +# if defined(PERL_IN_PP_C) || defined(PERL_IN_PP_HOT_C) +#define lossless_NV_to_IV S_lossless_NV_to_IV +# endif # if defined(PERL_IN_PP_CTL_C) #define check_type_and_open(a) S_check_type_and_open(aTHX_ a) #define destroy_matcher(a) S_destroy_matcher(aTHX_ a) diff --git a/inline.h b/inline.h index 654f801b75..de1e33e8ce 100644 --- a/inline.h +++ b/inline.h @@ -1913,6 +1913,40 @@ S_should_warn_nl(const char *pv) { #endif +#if defined(PERL_IN_PP_C) || defined(PERL_IN_PP_HOT_C) + +PERL_STATIC_INLINE bool +S_lossless_NV_to_IV(const NV nv, IV *ivp) +{ + /* This function determines if the input NV 'nv' may be converted without + * loss of data to an IV. If not, it returns FALSE taking no other action. + * But if it is possible, it does the conversion, returning TRUE, and + * storing the converted result in '*ivp' */ + + PERL_ARGS_ASSERT_LOSSLESS_NV_TO_IV; + +# if defined(Perl_isnan) + + if (UNLIKELY(Perl_isnan(nv))) { + return FALSE; + } + +# endif + + if (UNLIKELY(nv < IV_MIN) || UNLIKELY(nv > IV_MAX)) { + return FALSE; + } + + if ((IV) nv != nv) { + return FALSE; + } + + *ivp = (IV) nv; + return TRUE; +} + +#endif + /* ------------------ pp.c, regcomp.c, toke.c, universal.c ------------ */ #define MAX_CHARSET_NAME_LENGTH 2 diff --git a/pp.c b/pp.c index c89cb7198c..0956121b27 100644 --- a/pp.c +++ b/pp.c @@ -1268,16 +1268,10 @@ PP(pp_multiply) NV nr = SvNVX(svr); NV result; - if ( -#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan) - !Perl_isnan(nl) && nl == (NV)(il = (IV)nl) - && !Perl_isnan(nr) && nr == (NV)(ir = (IV)nr) -#else - nl == (NV)(il = (IV)nl) && nr == (NV)(ir = (IV)nr) -#endif - ) + if (lossless_NV_to_IV(nl, &il) && lossless_NV_to_IV(nr, &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_BE_BE && NVSIZE == 16 @@ -1849,16 +1843,10 @@ PP(pp_subtract) NV nl = SvNVX(svl); NV nr = SvNVX(svr); - if ( -#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan) - !Perl_isnan(nl) && nl == (NV)(il = (IV)nl) - && !Perl_isnan(nr) && nr == (NV)(ir = (IV)nr) -#else - nl == (NV)(il = (IV)nl) && nr == (NV)(ir = (IV)nr) -#endif - ) + if (lossless_NV_to_IV(nl, &il) && lossless_NV_to_IV(nr, &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); diff --git a/pp_hot.c b/pp_hot.c index 7d5ffc02fd..2df5df8303 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -1435,16 +1435,10 @@ PP(pp_add) NV nl = SvNVX(svl); NV nr = SvNVX(svr); - if ( -#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan) - !Perl_isnan(nl) && nl == (NV)(il = (IV)nl) - && !Perl_isnan(nr) && nr == (NV)(ir = (IV)nr) -#else - nl == (NV)(il = (IV)nl) && nr == (NV)(ir = (IV)nr) -#endif - ) + if (lossless_NV_to_IV(nl, &il) && lossless_NV_to_IV(nr, &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); diff --git a/proto.h b/proto.h index 0f8feed187..74a8e46ab7 100644 --- a/proto.h +++ b/proto.h @@ -5224,6 +5224,13 @@ STATIC SV* S_refto(pTHX_ SV* sv) #endif #if defined(PERL_IN_PP_C) || defined(PERL_IN_PP_HOT_C) +#ifndef PERL_NO_INLINE_FUNCTIONS +PERL_STATIC_INLINE bool S_lossless_NV_to_IV(const NV nv, IV * ivp) + __attribute__warn_unused_result__; +#define PERL_ARGS_ASSERT_LOSSLESS_NV_TO_IV \ + assert(ivp) +#endif + PERL_CALLCONV GV* Perl_softref2xv(pTHX_ SV *const sv, const char *const what, const svtype type, SV ***spp) __attribute__warn_unused_result__; #define PERL_ARGS_ASSERT_SOFTREF2XV \ -- 2.20.1