Skip to content

Commit

Permalink
Create fcn for lossless conversion of NV to IV
Browse files Browse the repository at this point in the history
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.
  • Loading branch information
khwilliamson committed May 24, 2019
1 parent 190e86d commit 3a019af
Show file tree
Hide file tree
Showing 6 changed files with 51 additions and 24 deletions.
1 change: 1 addition & 0 deletions embed.fnc
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
3 changes: 3 additions & 0 deletions embed.h
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
34 changes: 34 additions & 0 deletions inline.h
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
20 changes: 4 additions & 16 deletions pp.c
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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);
Expand Down
10 changes: 2 additions & 8 deletions pp_hot.c
Original file line number Diff line number Diff line change
Expand Up @@ -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);
Expand Down
7 changes: 7 additions & 0 deletions proto.h
Original file line number Diff line number Diff line change
Expand Up @@ -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 \
Expand Down

0 comments on commit 3a019af

Please sign in to comment.