infnan: add nan_hibyte

4 files changed, 43 insertions, 0 deletions

diff --git a/embed.fnc b/embed.fnc
index cfe634ff5d..b4944f2bc7 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -819,6 +819,7 @@ Apd	|int	|grok_number_flags|NN const char *pv|STRLEN len|NULLOK UV *valuep|U32 f
 ApdR	|bool	|grok_numeric_radix|NN const char **sp|NN const char *send
 Apd	|UV	|grok_oct	|NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV *result
 Apdn	|UV	|grok_atou	|NN const char* pv|NULLOK const char** endptr
+Apd	|U8*	|nan_hibyte|NN NV *nvp|NN U8* mask
 : These are all indirectly referenced by globals.c. This is somewhat annoying.
 p	|int	|magic_clearenv	|NN SV* sv|NN MAGIC* mg
 p	|int	|magic_clear_all_env|NN SV* sv|NN MAGIC* mg
diff --git a/embed.h b/embed.h
index 802b624598..d7afa710bb 100644
--- a/embed.h
+++ b/embed.h
@@ -356,6 +356,7 @@
 #define my_socketpair		Perl_my_socketpair
 #define my_strerror(a)		Perl_my_strerror(aTHX_ a)
 #define my_strftime(a,b,c,d,e,f,g,h,i,j)	Perl_my_strftime(aTHX_ a,b,c,d,e,f,g,h,i,j)
+#define nan_hibyte(a,b)		Perl_nan_hibyte(aTHX_ a,b)
 #define newANONATTRSUB(a,b,c,d)	Perl_newANONATTRSUB(aTHX_ a,b,c,d)
 #define newANONHASH(a)		Perl_newANONHASH(aTHX_ a)
 #define newANONLIST(a)		Perl_newANONLIST(aTHX_ a)
diff --git a/numeric.c b/numeric.c
index a6f6018adc..16717aa412 100644
--- a/numeric.c
+++ b/numeric.c
@@ -548,6 +548,41 @@ Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send)
 }
 
 /*
+=for apidoc nan_hibyte
+
+Given an NV, returns pointer to the byte containing the most
+significant bit of the NaN, this bit is most commonly the
+quiet/signaling bit of the NaN.  The mask will contain a mask
+appropriate for manipulating the most significant bit.
+Note that this bit may not be the highest bit of the byte.
+
+If the NV is not a NaN, returns NULL.
+
+Most platforms have "high bit is one" -> quiet nan.
+The known opposite exceptions are older MIPS and HPPA platforms.
+
+Some platforms do not differentiate between quiet and signaling NaNs.
+
+=cut
+*/
+U8*
+Perl_nan_hibyte(NV *nvp, U8* mask)
+{
+    STRLEN i = (NV_MANT_REAL_DIG - 1) / 8;
+    STRLEN j = (NV_MANT_REAL_DIG - 1) % 8;
+
+    PERL_ARGS_ASSERT_NAN_HIBYTE;
+
+    *mask = 1 << j;
+#ifdef NV_BIG_ENDIAN
+    return (U8*) nvp + NVSIZE - 1 - i;
+#endif
+#ifdef NV_LITTLE_ENDIAN
+    return (U8*) nvp + i;
+#endif
+}
+
+/*
 =for apidoc grok_infnan
 
 Helper for grok_number(), accepts various ways of spelling "infinity"
diff --git a/proto.h b/proto.h
index 966c6d880d..77a8e7f4cc 100644
--- a/proto.h
+++ b/proto.h
@@ -2838,6 +2838,12 @@ PERL_CALLCONV int	Perl_my_vsnprintf(char *buffer, const Size_t len, const char *
 #define PERL_ARGS_ASSERT_MY_VSNPRINTF	\
 	assert(buffer); assert(format)
 
+PERL_CALLCONV U8*	Perl_nan_hibyte(pTHX_ NV *nvp, U8* mask)
+			__attribute__nonnull__(pTHX_1)
+			__attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_NAN_HIBYTE	\
+	assert(nvp); assert(mask)
+
 PERL_CALLCONV OP*	Perl_newANONATTRSUB(pTHX_ I32 floor, OP *proto, OP *attrs, OP *block);
 PERL_CALLCONV OP*	Perl_newANONHASH(pTHX_ OP* o)
 			__attribute__malloc__