infnan: add nan_hibyte

diff --git a/embed.fnc b/embed.fnc
index cfe634f..b4944f2 100644 (file)
--- 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 802b624..d7afa71 100644 (file)
--- 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 a6f6018..16717aa 100644 (file)
--- 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 966c6d8..77a8e7f 100644 (file)
--- 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__