IV/UV casting fixes from Nicholas Clark.

p4raw-id: //depot/perl@10198

diff --git a/perl.h b/perl.h
index 6ef79c2..ab99e85 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -2116,25 +2116,52 @@ struct ptr_tbl {
        /* otherwise default to functions in util.c */
 #endif
 
-#ifdef CASTNEGFLOAT
-#define U_S(what) ((U16)(what))
-#define U_I(what) ((unsigned int)(what))
-#define U_L(what) ((U32)(what))
-#else
-#define U_S(what) ((U16)cast_ulong((NV)(what)))
-#define U_I(what) ((unsigned int)cast_ulong((NV)(what)))
-#define U_L(what) (cast_ulong((NV)(what)))
-#endif
+/* *MAX Plus 1. A floating point value.
+   Hopefully expressed in a way that dodgy floating point can't mess up.
+   >> 2 rather than 1, so that value is safely less than I32_MAX after 1
+   is added to it
+   May find that some broken compiler will want the value cast to I32.
+   [after the shift, as signed >> may not be as secure as unsigned >>]
+*/
+#define I32_MAX_P1 (2.0 * (1 + (((U32)I32_MAX) >> 1)))
+#define U32_MAX_P1 (4.0 * (1 + ((U32_MAX) >> 2)))
+/* For compilers that can't correctly cast NVs over 0x7FFFFFFF (or
+   0x7FFFFFFFFFFFFFFF) to an unsigned integer. In the future, sizeof(UV)
+   may be greater than sizeof(IV), so don't assume that half max UV is max IV.
+*/
+#define U32_MAX_P1_HALF (2.0 * (1 + ((U32_MAX) >> 2)))
 
-#ifdef CASTI32
-#define I_32(what) ((I32)(what))
-#define I_V(what) ((IV)(what))
-#define U_V(what) ((UV)(what))
-#else
+#define UV_MAX_P1 (4.0 * (1 + ((UV_MAX) >> 2)))
+#define IV_MAX_P1 (2.0 * (1 + (((UV)IV_MAX) >> 1)))
+#define UV_MAX_P1_HALF (2.0 * (1 + ((UV_MAX) >> 2)))
+
+/* This may look like unnecessary jumping through hoops, but converting
+   out of range floating point values to integers *is* undefined behaviour,
+   and it is starting to bite.
+*/
+#ifndef CAST_INLINE
 #define I_32(what) (cast_i32((NV)(what)))
+#define U_32(what) (cast_ulong((NV)(what)))
 #define I_V(what) (cast_iv((NV)(what)))
 #define U_V(what) (cast_uv((NV)(what)))
-#endif
+#else
+#define I_32(n) ((n) < I32_MAX_P1 ? ((n) < I32_MIN ? I32_MIN : (I32) (n)) \
+                  : ((n) < U32_MAX_P1 ? (I32)(U32) (n) \
+                     : ((n) > 0 ? (I32) U32_MAX : 0 /* NaN */)))
+#define U_32(n) ((n) < 0.0 ? ((n) < I32_MIN ? (UV) I32_MIN : (U32)(I32) (n)) \
+                  : ((n) < U32_MAX_P1 ? (U32) (n) \
+                     : ((n) > 0 ? U32_MAX : 0 /* NaN */)))
+#define I_V(n) ((n) < IV_MAX_P1 ? ((n) < IV_MIN ? IV_MIN : (IV) (n)) \
+                  : ((n) < UV_MAX_P1 ? (IV)(UV) (n) \
+                     : ((n) > 0 ? (IV)UV_MAX : 0 /* NaN */)))
+#define U_V(n) ((n) < 0.0 ? ((n) < IV_MIN ? (UV) IV_MIN : (UV)(IV) (n)) \
+                  : ((n) < UV_MAX_P1 ? (UV) (n) \
+                     : ((n) > 0 ? UV_MAX : 0 /* NaN */)))
+#endif
+
+#define U_S(what) ((U16)U_32(what))
+#define U_I(what) ((unsigned int)U_32(what))
+#define U_L(what) U_32(what)
 
 /* These do not care about the fractional part, only about the range. */
 #define NV_WITHIN_IV(nv) (I_V(nv) >= IV_MIN && I_V(nv) <= IV_MAX)

diff --git a/pp_sys.c b/pp_sys.c
index ed59638..e9f761e 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -2070,7 +2070,7 @@ PP(pp_ioctl)
 {
     dSP; dTARGET;
     SV *argsv = POPs;
-    unsigned int func = U_I(POPn);
+    unsigned int func = POPu;
     int optype = PL_op->op_type;
     char *s;
     IV retval;
@@ -4658,7 +4658,7 @@ PP(pp_gnetent)
     else if (which == OP_GNBYADDR) {
 #ifdef HAS_GETNETBYADDR
        int addrtype = POPi;
-       Netdb_net_t addr = (Netdb_net_t) U_L(POPn);
+       Netdb_net_t addr = (Netdb_net_t) (U32)POPu;
        nent = PerlSock_getnetbyaddr(addr, addrtype);
 #else
        DIE(aTHX_ PL_no_sock_func, "getnetbyaddr");

diff --git a/util.c b/util.c
index f91c86a..d33af51 100644 (file)
--- a/util.c
+++ b/util.c
@@ -2923,80 +2923,74 @@ Perl_repeatcpy(pTHX_ register char *to, register const char *from, I32 len, regi
 U32
 Perl_cast_ulong(pTHX_ NV f)
 {
-    long along;
-
+  if (f < 0.0)
+    return f < I32_MIN ? (U32) I32_MIN : (U32)(I32) f;
+  if (f < U32_MAX_P1) {
 #if CASTFLAGS & 2
-#   define BIGDOUBLE 2147483648.0
-    if (f >= BIGDOUBLE)
-       return (unsigned long)(f-(long)(f/BIGDOUBLE)*BIGDOUBLE)|0x80000000;
+    if (f < U32_MAX_P1_HALF)
+      return (U32) f;
+    f -= U32_MAX_P1_HALF;
+    return ((U32) f) | (1 + U32_MAX >> 1);
+#else
+    return (U32) f;
 #endif
-    if (f >= 0.0)
-       return (unsigned long)f;
-    along = (long)f;
-    return (unsigned long)along;
+  }
+  return f > 0 ? U32_MAX : 0 /* NaN */;
 }
-# undef BIGDOUBLE
-
-/* Unfortunately, on some systems the cast_uv() function doesn't
-   work with the system-supplied definition of ULONG_MAX.  The
-   comparison  (f >= ULONG_MAX) always comes out true.  It must be a
-   problem with the compiler constant folding.
-
-   In any case, this workaround should be fine on any two's complement
-   system.  If it's not, supply a '-DMY_ULONG_MAX=whatever' in your
-   ccflags.
-              --Andy Dougherty      <doughera@lafcol.lafayette.edu>
-*/
-
-/* Code modified to prefer proper named type ranges, I32, IV, or UV, instead
-   of LONG_(MIN/MAX).
-                           -- Kenneth Albanowski <kjahds@kjahds.com>
-*/
-
-#ifndef MY_UV_MAX
-#  define MY_UV_MAX ((UV)IV_MAX * (UV)2 + (UV)1)
-#endif
 
 I32
 Perl_cast_i32(pTHX_ NV f)
 {
-    if (f >= I32_MAX)
-       return (I32) I32_MAX;
-    if (f <= I32_MIN)
-       return (I32) I32_MIN;
-    return (I32) f;
+  if (f < I32_MAX_P1)
+    return f < I32_MIN ? I32_MIN : (I32) f;
+  if (f < U32_MAX_P1) {
+#if CASTFLAGS & 2
+    if (f < U32_MAX_P1_HALF)
+      return (I32)(U32) f;
+    f -= U32_MAX_P1_HALF;
+    return (I32)(((U32) f) | (1 + U32_MAX >> 1));
+#else
+    return (I32)(U32) f;
+#endif
+  }
+  return f > 0 ? (I32)U32_MAX : 0 /* NaN */;
 }
 
 IV
 Perl_cast_iv(pTHX_ NV f)
 {
-    if (f >= IV_MAX) {
-       UV uv;
-       
-       if (f >= (NV)UV_MAX)
-           return (IV) UV_MAX; 
-       uv = (UV) f;
-       return (IV)uv;
-    }
-    if (f <= IV_MIN)
-       return (IV) IV_MIN;
-    return (IV) f;
+  if (f < IV_MAX_P1)
+    return f < IV_MIN ? IV_MIN : (IV) f;
+  if (f < UV_MAX_P1) {
+#if CASTFLAGS & 2
+    /* For future flexibility allowing for sizeof(UV) >= sizeof(IV)  */
+    if (f < UV_MAX_P1_HALF)
+      return (IV)(UV) f;
+    f -= UV_MAX_P1_HALF;
+    return (IV)(((UV) f) | (1 + UV_MAX >> 1));
+#else
+    return (IV)(UV) f;
+#endif
+  }
+  return f > 0 ? (IV)UV_MAX : 0 /* NaN */;
 }
 
 UV
 Perl_cast_uv(pTHX_ NV f)
 {
-    if (f >= MY_UV_MAX)
-       return (UV) MY_UV_MAX;
-    if (f < 0) {
-       IV iv;
-       
-       if (f < IV_MIN)
-           return (UV)IV_MIN;
-       iv = (IV) f;
-       return (UV) iv;
-    }
+  if (f < 0.0)
+    return f < IV_MIN ? (UV) IV_MIN : (UV)(IV) f;
+  if (f < UV_MAX_P1) {
+#if CASTFLAGS & 2
+    if (f < UV_MAX_P1_HALF)
+      return (UV) f;
+    f -= UV_MAX_P1_HALF;
+    return ((UV) f) | (1 + UV_MAX >> 1);
+#else
     return (UV) f;
+#endif
+  }
+  return f > 0 ? UV_MAX : 0 /* NaN */;
 }
 
 #ifndef HAS_RENAME