This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
infnan: API context juggling
authorJarkko Hietaniemi <jhi@iki.fi>
Sun, 8 Feb 2015 00:39:55 +0000 (19:39 -0500)
committerJarkko Hietaniemi <jhi@iki.fi>
Mon, 9 Feb 2015 02:54:50 +0000 (21:54 -0500)
embed.fnc
embed.h
numeric.c
proto.h
sv.c

index f3deba1..fb2c1ac 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -822,10 +822,10 @@ Apd       |int    |grok_number2_flags|NN const char *pv|STRLEN len|NULLOK UV *valuep|NULL
 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
+Apdn   |U8*    |nan_hibyte|NN NV *nvp|NN U8* mask
 Apd    |void   |nan_signaling_set|NN NV *nvp|bool signaling
-Apd    |int    |nan_is_signaling|NV nv
-Apdn   |void   |nan_payload_set|NN NV *nvp|NN const void *bytes|STRLEN byten|bool signaling
+Apdn   |int    |nan_is_signaling|NV nv
+Apd    |void   |nan_payload_set|NN NV *nvp|NN const void *bytes|STRLEN byten|bool signaling
 : 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 0475243..0c43ce7 100644 (file)
--- a/embed.h
+++ b/embed.h
 #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 nan_is_signaling(a)    Perl_nan_is_signaling(aTHX_ a)
-#define nan_payload_set                Perl_nan_payload_set
+#define nan_hibyte             Perl_nan_hibyte
+#define nan_is_signaling       Perl_nan_is_signaling
+#define nan_payload_set(a,b,c,d)       Perl_nan_payload_set(aTHX_ a,b,c,d)
 #define nan_signaling_set(a,b) Perl_nan_signaling_set(aTHX_ a,b)
 #define newANONATTRSUB(a,b,c,d)        Perl_newANONATTRSUB(aTHX_ a,b,c,d)
 #define newANONHASH(a)         Perl_newANONHASH(aTHX_ a)
index bf92e32..88770b7 100644 (file)
--- a/numeric.c
+++ b/numeric.c
@@ -597,7 +597,7 @@ semantics, and we set the bit for a signaling NaN.
 =cut
 */
 void
-Perl_nan_signaling_set(NV *nvp, bool signaling)
+Perl_nan_signaling_set(pTHX_ NV *nvp, bool signaling)
 {
     U8 mask;
     U8* hibyte;
@@ -652,7 +652,7 @@ Perl_nan_is_signaling(NV nv)
 #else
     if (Perl_isnan(nv)) {
         U8 mask;
-        U8 *hibyte = Perl_nan_hibyte(&nv, &mask);
+        U8 *hibyte = nan_hibyte(&nv, &mask);
         /* Hoping NV_NAN is a quiet nan - this might be a false hope.
          * XXX Configure test */
         const NV nan = NV_NAN;
@@ -685,7 +685,7 @@ Do not assume any portability of the NaN semantics.
 =cut
 */
 void
-Perl_nan_payload_set(NV *nvp, const void *bytes, STRLEN byten, bool signaling)
+Perl_nan_payload_set(pTHX_ NV *nvp, const void *bytes, STRLEN byten, bool signaling)
 {
     /* How many bits we can set in the payload.
      *
diff --git a/proto.h b/proto.h
index 62585a4..765c85d 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -2857,16 +2857,16 @@ 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);
+PERL_CALLCONV U8*      Perl_nan_hibyte(NV *nvp, U8* mask)
+                       __attribute__nonnull__(1)
+                       __attribute__nonnull__(2);
 #define PERL_ARGS_ASSERT_NAN_HIBYTE    \
        assert(nvp); assert(mask)
 
-PERL_CALLCONV int      Perl_nan_is_signaling(pTHX_ NV nv);
-PERL_CALLCONV void     Perl_nan_payload_set(NV *nvp, const void *bytes, STRLEN byten, bool signaling)
-                       __attribute__nonnull__(1)
-                       __attribute__nonnull__(2);
+PERL_CALLCONV int      Perl_nan_is_signaling(NV nv);
+PERL_CALLCONV void     Perl_nan_payload_set(pTHX_ NV *nvp, const void *bytes, STRLEN byten, bool signaling)
+                       __attribute__nonnull__(pTHX_1)
+                       __attribute__nonnull__(pTHX_2);
 #define PERL_ARGS_ASSERT_NAN_PAYLOAD_SET       \
        assert(nvp); assert(bytes)
 
diff --git a/sv.c b/sv.c
index d430049..c3f77e3 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -2959,7 +2959,7 @@ S_uiv_2buf(char *const buf, const IV iv, UV uv, const int is_uv, char **const pe
  * (the extraction of the hexadecimal values) takes place.
  * Sanity failures cause fatal failures during both rounds. */
 STATIC U8*
-S_hextract(pTHX_ const NV nv, int* exponent, U8* vhex, U8* vend)
+S_hextract(const NV nv, int* exponent, U8* vhex, U8* vend)
 {
     U8* v = vhex;
     int ix;
@@ -3021,7 +3021,7 @@ S_hextract(pTHX_ const NV nv, int* exponent, U8* vhex, U8* vend)
     if (!Perl_isinfnan(nv)) {
         (void)Perl_frexp(PERL_ABS(nv), exponent);
         if (vend && (vend <= vhex || vend > vmaxend))
-            Perl_croak(aTHX_ "Hexadecimal float: internal error");
+            Perl_croak_nocontext("Hexadecimal float: internal error");
     }
     {
         /* First check if using long doubles. */
@@ -3229,7 +3229,7 @@ S_hextract(pTHX_ const NV nv, int* exponent, U8* vhex, U8* vend)
          * for double-double. */
         ixmin < 0 || ixmax >= NVSIZE ||
         (vend && v != vend))
-        Perl_croak(aTHX_ "Hexadecimal float: internal error");
+        Perl_croak_nocontext("Hexadecimal float: internal error");
     return v;
 }
 
@@ -3284,8 +3284,8 @@ S_infnan_2pv(NV nv, char* buffer, size_t maxlen, char format, char plus, char al
                  * byte that are not part of the payload. */
                 *hibyte &= (1 << (7 - NV_MANT_REAL_DIG % 8)) - 1;
 
-                vend = S_hextract(aTHX_ payload, &exponent, vhex, NULL);
-                S_hextract(aTHX_ payload, &exponent, vhex, vend);
+                vend = S_hextract(payload, &exponent, vhex, NULL);
+                S_hextract(payload, &exponent, vhex, vend);
 
                 v = vhex;
 
@@ -12389,8 +12389,8 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                  * should be output as 0x0.0000000000001p-1022 to
                  * match its internal structure. */
 
-                vend = S_hextract(aTHX_ nv, &exponent, vhex, NULL);
-                S_hextract(aTHX_ nv, &exponent, vhex, vend);
+                vend = S_hextract(nv, &exponent, vhex, NULL);
+                S_hextract(nv, &exponent, vhex, vend);
 
 #if NVSIZE > DOUBLESIZE
 #  ifdef HEXTRACT_HAS_IMPLICIT_BIT