More verbose debugging.
[p5sagit/p5-mst-13.2.git] / perl.h
diff --git a/perl.h b/perl.h
index 35629d0..4561467 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -226,7 +226,7 @@ struct perl_thread;
 #endif
 
 #define NOOP (void)0
-#define dNOOP extern int Perl___notused
+#define dNOOP extern int Perl___notused __attribute__ ((unused))
 
 #ifndef pTHX
 #  define pTHX         void
@@ -1311,24 +1311,8 @@ typedef NVTYPE NV;
 #   endif
 #endif
 
-#if !defined(Perl_atof) && defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
-#   if !defined(Perl_atof) && defined(HAS_STRTOLD)
-#       define Perl_atof(s) (NV)strtold(s, (char**)NULL)
-#   endif
-#   if !defined(Perl_atof) && defined(HAS_ATOLF)
-#       define Perl_atof (NV)atolf
-#   endif
-#   if !defined(Perl_atof) && defined(PERL_SCNfldbl)
-#       define Perl_atof PERL_SCNfldbl
-#       define Perl_atof2(s,f) sscanf((s), "%"PERL_SCNfldbl, &(f))
-#   endif
-#endif
-#if !defined(Perl_atof)
-#   define Perl_atof atof /* we assume atof being available anywhere */
-#endif
-#if !defined(Perl_atof2)
-#   define Perl_atof2(s,f) ((f) = (NV)Perl_atof(s))
-#endif
+#define Perl_atof(s) Perl_my_atof(s)
+#define Perl_atof2(s, np) Perl_my_atof2(s, np)
 
 /* Previously these definitions used hardcoded figures.
  * It is hoped these formula are more portable, although
@@ -2112,25 +2096,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)
@@ -2236,23 +2247,28 @@ Gid_t getegid (void);
     } STMT_END
 #  endif
 
-#  define DEBUG_f(a) if (DEBUG_f_TEST) a
-#  define DEBUG_r(a) if (DEBUG_r_TEST) a
-#  define DEBUG_x(a) if (DEBUG_x_TEST) a
-#  define DEBUG_u(a) if (DEBUG_u_TEST) a
-#  define DEBUG_L(a) if (DEBUG_L_TEST) a
-#  define DEBUG_H(a) if (DEBUG_H_TEST) a
-#  define DEBUG_X(a) if (DEBUG_X_TEST) a
-#  define DEBUG_D(a) if (DEBUG_D_TEST) a
+#  define DEBUG__(t, a) \
+       STMT_START { \
+               if (t) STMT_START {a;} STMT_END; \
+       } STMT_END
+
+#  define DEBUG_f(a) DEBUG__(DEBUG_f_TEST, a)
+#  define DEBUG_r(a) DEBUG__(DEBUG_r_TEST, a)
+#  define DEBUG_x(a) DEBUG__(DEBUG_x_TEST, a)
+#  define DEBUG_u(a) DEBUG__(DEBUG_u_TEST, a)
+#  define DEBUG_L(a) DEBUG__(DEBUG_L_TEST, a)
+#  define DEBUG_H(a) DEBUG__(DEBUG_H_TEST, a)
+#  define DEBUG_X(a) DEBUG__(DEBUG_X_TEST, a)
+#  define DEBUG_D(a) DEBUG__(DEBUG_D_TEST, a)
 
 #  ifdef USE_THREADS
-#    define DEBUG_S(a) if (DEBUG_S_TEST) a
+#    define DEBUG_S(a) DEBUG__(DEBUG_S_TEST, a)
 #  else
 #    define DEBUG_S(a)
 #  endif
 
-#  define DEBUG_T(a) if (DEBUG_T_TEST) a
-#  define DEBUG_R(a) if (DEBUG_R_TEST) a
+#  define DEBUG_T(a) DEBUG__(DEBUG_T_TEST, a)
+#  define DEBUG_R(a) DEBUG__(DEBUG_R_TEST, a)
 
 #else /* DEBUGGING */
 
@@ -2300,6 +2316,52 @@ Gid_t getegid (void);
 #endif /* DEBUGGING */
 
 
+/* These constants should be used in preference to to raw characters
+ * when using magic. Note that some perl guts still assume
+ * certain character properties of these constants, namely that
+ * isUPPER() and toLOWER() may do useful mappings.
+ *
+ * Update the magic_names table in dump.c when adding/amending these
+ */
+
+#define PERL_MAGIC_sv            '\0' /* Special scalar variable */
+#define PERL_MAGIC_overload      'A' /* %OVERLOAD hash */
+#define PERL_MAGIC_overload_elem  'a' /* %OVERLOAD hash element */
+#define PERL_MAGIC_overload_table 'c' /* Holds overload table (AMT) on stash */
+#define PERL_MAGIC_bm            'B' /* Boyer-Moore (fast string search) */
+#define PERL_MAGIC_regdata       'D' /* Regex match position data
+                                       (@+ and @- vars) */
+#define PERL_MAGIC_regdatum      'd' /* Regex match position data element */
+#define PERL_MAGIC_env           'E' /* %ENV hash */
+#define PERL_MAGIC_envelem       'e' /* %ENV hash element */
+#define PERL_MAGIC_fm            'f' /* Formline ('compiled' format) */
+#define PERL_MAGIC_regex_global          'g' /* m//g target / study()ed string */
+#define PERL_MAGIC_isa           'I' /* @ISA array */
+#define PERL_MAGIC_isaelem       'i' /* @ISA array element */
+#define PERL_MAGIC_nkeys         'k' /* scalar(keys()) lvalue */
+#define PERL_MAGIC_dbfile        'L' /* Debugger %_<filename */
+#define PERL_MAGIC_dbline        'l' /* Debugger %_<filename element */
+#define PERL_MAGIC_mutex         'm' /* ??? */
+#define PERL_MAGIC_collxfrm      'o' /* Locale transformation */
+#define PERL_MAGIC_tied                  'P' /* Tied array or hash */
+#define PERL_MAGIC_tiedelem      'p' /* Tied array or hash element */
+#define PERL_MAGIC_tiedscalar    'q' /* Tied scalar or handle */
+#define PERL_MAGIC_qr            'r' /* precompiled qr// regex */
+#define PERL_MAGIC_sig           'S' /* %SIG hash */
+#define PERL_MAGIC_sigelem       's' /* %SIG hash element */
+#define PERL_MAGIC_taint         't' /* Taintedness */
+#define PERL_MAGIC_uvar                  'U' /* Available for use by extensions */
+#define PERL_MAGIC_vec           'v' /* vec() lvalue */
+#define PERL_MAGIC_substr        'x' /* substr() lvalue */
+#define PERL_MAGIC_defelem       'y' /* Shadow "foreach" iterator variable /
+                                       smart parameter vivification */
+#define PERL_MAGIC_glob                  '*' /* GV (typeglob) */
+#define PERL_MAGIC_arylen        '#' /* Array length ($#ary) */
+#define PERL_MAGIC_pos           '.' /* pos() lvalue */
+#define PERL_MAGIC_backref       '<' /* ??? */
+#define PERL_MAGIC_ext           '~' /* Available for use by extensions */
+
+
 #define YYMAXDEPTH 300
 
 #ifndef assert  /* <assert.h> might have been included somehow */
@@ -2317,7 +2379,7 @@ struct ufuncs {
     IV uf_index;
 };
 
-/* In pre-5.7-Perls the 'U' magic didn't get the thread context.
+/* In pre-5.7-Perls the PERL_MAGIC_uvar magic didn't get the thread context.
  * XS code wanting to be backward compatible can do something
  * like the following:
 
@@ -2409,6 +2471,13 @@ I32 unlnk (char*);
 #define UNLINK PerlLIO_unlink
 #endif
 
+#ifndef HAS_SETRESUID_PROTO /* some versions of glibc */
+int setresuid(uid_t ruid, uid_t euid, uid_t suid);
+#endif
+#ifndef HAS_SETRESUID_PROTO /* some versions of glibc */
+int setresgid(gid_t rgid, gid_t egid, gid_t sgid);
+#endif
+
 #ifndef HAS_SETREUID
 #  ifdef HAS_SETRESUID
 #    define setreuid(r,e) setresuid(r,e,(Uid_t)-1)
@@ -2818,7 +2887,7 @@ enum {            /* pass one of these to get_vtbl */
 #define HINT_INTEGER           0x00000001
 #define HINT_STRICT_REFS       0x00000002
 /* #define HINT_notused4       0x00000004 */
-#define HINT_BYTE              0x00000008
+#define HINT_BYTES             0x00000008
 /* #define HINT_notused10      0x00000010 */
                                /* Note: 20,40,80 used for NATIVE_HINTS */
 
@@ -3585,6 +3654,9 @@ typedef struct am_table_short AMTS;
 #ifdef IAMSUID
 
 #ifdef I_SYS_STATVFS
+#   if defined(PERL_SCO) && !defined(_SVID3)
+#       define _SVID3
+#   endif
 #   include <sys/statvfs.h>     /* for f?statvfs() */
 #endif
 #ifdef I_SYS_MOUNT