/* handy.h
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1999,
- * 2000, 2001, 2002, 2004, by Larry Wall and others
+ * 2000, 2001, 2002, 2004, 2005 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/*
=head1 Handy Values
-=for apidoc AmU||Nullch
+=for apidoc AmU||Nullch
Null character pointer.
=for apidoc AmU||Nullsv
g++ can be identified by __GNUG__.
Andy Dougherty February 2000
*/
-#ifdef __GNUG__ /* GNU g++ has bool built-in */
+#ifdef __GNUG__ /* GNU g++ has bool built-in */
# ifndef HAS_BOOL
# define HAS_BOOL 1
# endif
# define HAS_BOOL 1
#endif
+/* Try to figure out __func__ or __FUNCTION__ equivalent, if any.
+ * XXX Should really be a Configure probe, with HAS__FUNCTION__
+ * and FUNCTION__ as results.
+ * XXX Similarly, a Configure probe for __FILE__ and __LINE__ is needed. */
+#if (defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L) || (defined(__SUNPRO_C)) /* C99 or close enough. */
+# define FUNCTION__ __func__
+#else
+# if (defined(_MSC_VER) && _MSC_VER < 1300) || /* Pre-MSVC 7.0 has neither __func__ nor __FUNCTION and no good workarounds, either. */ \
+ (defined(__DECC_VER)) /* Tru64 or VMS, and strict C89 being used, but not modern enough cc (in Tur64, -c99 not known, only -std1). */
+# define FUNCTION__ ""
+# else
+# define FUNCTION__ __FUNCTION__ /* Common extension. */
+# endif
+#endif
+
/* XXX A note on the perl source internal type system. The
original intent was that I32 be *exactly* 32 bits.
For dealing with issues that may arise from various 32/64-bit
systems, we will ask Configure to check out
- SHORTSIZE == sizeof(short)
- INTSIZE == sizeof(int)
- LONGSIZE == sizeof(long)
+ SHORTSIZE == sizeof(short)
+ INTSIZE == sizeof(int)
+ LONGSIZE == sizeof(long)
LONGLONGSIZE == sizeof(long long) (if HAS_LONG_LONG)
- PTRSIZE == sizeof(void *)
+ PTRSIZE == sizeof(void *)
DOUBLESIZE == sizeof(double)
LONG_DOUBLESIZE == sizeof(long double) (if HAS_LONG_DOUBLE).
# endif
#endif
-/* H.Merijn Brand [ 01 Nov 2004 ] */
-#if defined(HAS_STRLCAT) || defined(HAS_STRLCPY)
-/* Not (yet) used at top level, but mention them for metaconfig
- * Read http://www.courtesan.com/todd/papers/strlcpy.html
- * for the discussion of why replacing strncat/strncpy with
- * strlcat/strlcpy would be wise */
+/* HMB H.Merijn Brand - a placeholder for preparing Configure patches */
+#if defined(HAS_MALLOC_SIZE) && defined(HAS_MALLOC_GOOD_SIZE) && defined(HAS_CLEARENV)
+/* Not (yet) used at top level, but mention them for metaconfig */
#endif
/* Mention I8SIZE, U8SIZE, I16SIZE, U16SIZE, I32SIZE, U32SIZE,
# else
-# define isALNUM_LC(c) (isascii(c) && (isalnum(c) || (c) == '_'))
+# define isALNUM_LC(c) (isascii(c) && (isalnum(c) || (c) == '_'))
# define isIDFIRST_LC(c) (isascii(c) && (isalpha(c) || (c) == '_'))
# define isALPHA_LC(c) (isascii(c) && isalpha(c))
# define isSPACE_LC(c) (isascii(c) && isspace(c))
/* Line numbers are unsigned, 32 bits. */
typedef U32 line_t;
-#ifdef lint
-#define NOLINE ((line_t)0)
-#else
#define NOLINE ((line_t) 4294967295UL)
-#endif
/*
=head1 Memory Management
-=for apidoc Am|void|New|int id|void* ptr|int nitems|type
+=for apidoc Am|void|Newx|void* ptr|int nitems|type
The XSUB-writer's interface to the C C<malloc> function.
-=for apidoc Am|void|Newc|int id|void* ptr|int nitems|type|cast
+In 5.9.3, Newx() and friends replace the older New() API, and drops
+the first parameter, I<x>, a debug aid which allowed callers to identify
+themselves. This aid has been superceded by a new build option,
+PERL_MEM_LOG (see L<perlhack/PERL_MEM_LOG>). The older API is still
+there for use in XS modules supporting older perls.
+
+=for apidoc Am|void|Newxc|void* ptr|int nitems|type|cast
The XSUB-writer's interface to the C C<malloc> function, with
-cast.
+cast. See also C<Newx>.
-=for apidoc Am|void|Newz|int id|void* ptr|int nitems|type
+=for apidoc Am|void|Newxz|void* ptr|int nitems|type
The XSUB-writer's interface to the C C<malloc> function. The allocated
-memory is zeroed with C<memzero>.
+memory is zeroed with C<memzero>. See also C<Newx>.
=for apidoc Am|void|Renew|void* ptr|int nitems|type
The XSUB-writer's interface to the C C<realloc> function.
=cut */
-#ifndef lint
-
#define NEWSV(x,len) newSV(len)
#ifdef PERL_MALLOC_WRAP
#define MEM_WRAP_CHECK(n,t) \
- (void)((n)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(PL_memory_wrap),0):0)
+ (void)((sizeof(t)>1?(n):1)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(PL_memory_wrap),0):0)
#define MEM_WRAP_CHECK_1(n,t,a) \
- (void)((n)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(a),0):0)
+ (void)((sizeof(t)>1?(n):1)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(a),0):0)
#define MEM_WRAP_CHECK_2(n,t,a,b) \
- (void)((n)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(a,b),0):0)
+ (void)((sizeof(t)>1?(n):1)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(a,b),0):0)
+#define MEM_WRAP_CHECK_(n,t) MEM_WRAP_CHECK(n,t),
-#define New(x,v,n,t) (v = (MEM_WRAP_CHECK(n,t), (t*)safemalloc((MEM_SIZE)((n)*sizeof(t)))))
-#define Newc(x,v,n,t,c) (v = (MEM_WRAP_CHECK(n,t), (c*)safemalloc((MEM_SIZE)((n)*sizeof(t)))))
-#define Newz(x,v,n,t) (v = (MEM_WRAP_CHECK(n,t), (t*)safemalloc((MEM_SIZE)((n)*sizeof(t))))), \
- memzero((char*)(v), (n)*sizeof(t))
-#define Renew(v,n,t) \
- (v = (MEM_WRAP_CHECK(n,t), (t*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))))
-#define Renewc(v,n,t,c) \
- (v = (MEM_WRAP_CHECK(n,t), (c*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))))
-#define Safefree(d) safefree((Malloc_t)(d))
-
-#define Move(s,d,n,t) (MEM_WRAP_CHECK(n,t), (void)memmove((char*)(d),(const char*)(s), (n) * sizeof(t)))
-#define Copy(s,d,n,t) (MEM_WRAP_CHECK(n,t), (void)memcpy((char*)(d),(const char*)(s), (n) * sizeof(t)))
-#define Zero(d,n,t) (MEM_WRAP_CHECK(n,t), (void)memzero((char*)(d), (n) * sizeof(t)))
-
-#define MoveD(s,d,n,t) (MEM_WRAP_CHECK(n,t), memmove((char*)(d),(const char*)(s), (n) * sizeof(t)))
-#define CopyD(s,d,n,t) (MEM_WRAP_CHECK(n,t), memcpy((char*)(d),(const char*)(s), (n) * sizeof(t)))
-#ifdef HAS_MEMSET
-#define ZeroD(d,n,t) (MEM_WRAP_CHECK(n,t), memzero((char*)(d), (n) * sizeof(t)))
-#else
-/* Using bzero(), which returns void. */
-#define ZeroD(d,n,t) (MEM_WRAP_CHECK(n,t), memzero((char*)(d), (n) * sizeof(t)),d)
-#endif
-
-#define Poison(d,n,t) (MEM_WRAP_CHECK(n,t), (void)memset((char*)(d), 0xAB, (n) * sizeof(t)))
+#define PERL_STRLEN_ROUNDUP(n) ((void)(((n) > (MEM_SIZE)~0 - 2 * PERL_STRLEN_ROUNDUP_QUANTUM) ? (Perl_croak_nocontext(PL_memory_wrap),0):0),((n-1+PERL_STRLEN_ROUNDUP_QUANTUM)&~((MEM_SIZE)PERL_STRLEN_ROUNDUP_QUANTUM-1)))
#else
#define MEM_WRAP_CHECK(n,t)
#define MEM_WRAP_CHECK_1(n,t,a)
#define MEM_WRAP_CHECK_2(n,t,a,b)
+#define MEM_WRAP_CHECK_(n,t)
+
+#define PERL_STRLEN_ROUNDUP(n) (((n-1+PERL_STRLEN_ROUNDUP_QUANTUM)&~((MEM_SIZE)PERL_STRLEN_ROUNDUP_QUANTUM-1)))
+
+#endif
-#define New(x,v,n,t) (v = (t*)safemalloc((MEM_SIZE)((n)*sizeof(t))))
-#define Newc(x,v,n,t,c) (v = (c*)safemalloc((MEM_SIZE)((n)*sizeof(t))))
-#define Newz(x,v,n,t) (v = (t*)safemalloc((MEM_SIZE)((n)*sizeof(t)))), \
+#ifdef PERL_MEM_LOG
+/*
+ * If PERL_MEM_LOG is defined, all Newx()s, Renew()s, and Safefree()s
+ * go through functions, which are handy for debugging breakpoints, but
+ * which more importantly get the immediate calling environment (file and
+ * line number, and C function name if available) passed in. This info can
+ * then be used for logging the calls, for which one gets a sample
+ * implementation if PERL_MEM_LOG_STDERR is defined.
+ *
+ * Known problems:
+ * - all memory allocs do not get logged, only those
+ * that go through Newx() and derivatives (while all
+ * Safefrees do get logged)
+ * - __FILE__ and __LINE__ do not work everywhere
+ * - __func__ or __FUNCTION__ even less so
+ * - I think more goes on after the perlio frees but
+ * the thing is that STDERR gets closed (as do all
+ * the file descriptors)
+ * - no deeper calling stack than the caller of the Newx()
+ * or the kind, but do I look like a C reflection/introspection
+ * utility to you?
+ * - the function prototypes for the logging functions
+ * probably should maybe be somewhere else than handy.h
+ * - one could consider inlining (macrofying) the logging
+ * for speed, but I am too lazy
+ * - one could imagine recording the allocations in a hash,
+ * (keyed by the allocation address?), and maintain that
+ * through reallocs and frees, but how to do that without
+ * any News() happening...?
+ */
+
+Malloc_t Perl_mem_log_alloc(const UV n, const UV typesize, const char *typename, Malloc_t newalloc, const char *filename, const int linenumber, const char *funcname);
+
+Malloc_t Perl_mem_log_realloc(const UV n, const UV typesize, const char *typename, Malloc_t oldalloc, Malloc_t newalloc, const char *filename, const int linenumber, const char *funcname);
+
+Malloc_t Perl_mem_log_free(Malloc_t oldalloc, const char *filename, const int linenumber, const char *funcname);
+
+#endif
+
+#ifdef PERL_MEM_LOG
+#define MEM_LOG_ALLOC(n,t,a) Perl_mem_log_alloc(n,sizeof(t),STRINGIFY(t),a,__FILE__,__LINE__,FUNCTION__)
+#define MEM_LOG_REALLOC(n,t,v,a) Perl_mem_log_realloc(n,sizeof(t),STRINGIFY(t),v,a,__FILE__,__LINE__,FUNCTION__)
+#define MEM_LOG_FREE(a) Perl_mem_log_free(a,__FILE__,__LINE__,FUNCTION__)
+#endif
+
+#ifndef MEM_LOG_ALLOC
+#define MEM_LOG_ALLOC(n,t,a) (a)
+#endif
+#ifndef MEM_LOG_REALLOC
+#define MEM_LOG_REALLOC(n,t,v,a) (a)
+#endif
+#ifndef MEM_LOG_FREE
+#define MEM_LOG_FREE(a) (a)
+#endif
+
+#define Newx(v,n,t) (v = (MEM_WRAP_CHECK_(n,t) MEM_LOG_ALLOC(n,t,(t*)safemalloc((MEM_SIZE)((n)*sizeof(t))))))
+#define Newxc(v,n,t,c) (v = (MEM_WRAP_CHECK_(n,t) MEM_LOG_ALLOC(n,t,(c*)safemalloc((MEM_SIZE)((n)*sizeof(t))))))
+#define Newxz(v,n,t) (v = (MEM_WRAP_CHECK_(n,t) MEM_LOG_ALLOC(n,t,(t*)safemalloc((MEM_SIZE)((n)*sizeof(t)))))), \
memzero((char*)(v), (n)*sizeof(t))
+
+#ifndef PERL_CORE
+/* pre 5.9.x compatibility */
+#define New(x,v,n,t) Newx(v,n,t)
+#define Newc(x,v,n,t,c) Newxc(v,n,t,c)
+#define Newz(x,v,n,t) Newxz(v,n,t)
+#endif
+
#define Renew(v,n,t) \
- (v = (t*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t))))
+ (v = (MEM_WRAP_CHECK_(n,t) MEM_LOG_REALLOC(n,t,v,(t*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t))))))
#define Renewc(v,n,t,c) \
- (v = (c*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t))))
-#define Safefree(d) safefree((Malloc_t)(d))
-
-#define Move(s,d,n,t) (void)memmove((char*)(d),(const char*)(s), (n) * sizeof(t))
-#define Copy(s,d,n,t) (void)memcpy((char*)(d),(const char*)(s), (n) * sizeof(t))
-#define Zero(d,n,t) (void)memzero((char*)(d), (n) * sizeof(t))
+ (v = (MEM_WRAP_CHECK_(n,t) MEM_LOG_REALLOC(n,t,v,(c*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t))))))
-#define MoveD(s,d,n,t) memmove((char*)(d),(const char*)(s), (n) * sizeof(t))
-#define CopyD(s,d,n,t) memcpy((char*)(d),(const char*)(s), (n) * sizeof(t))
-#ifdef HAS_MEMSET
-#define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
+#ifdef PERL_POISON
+#define Safefree(d) \
+ ((d) ? (void)(safefree(MEM_LOG_FREE((Malloc_t)(d)))), Poison(&(d), 1, Malloc_t)) : (void) 0)
#else
-#define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)),d)
+#define Safefree(d) safefree(MEM_LOG_FREE((Malloc_t)(d)))
#endif
-#define Poison(d,n,t) (void)memset((char*)(d), 0xAB, (n) * sizeof(t))
+#define Move(s,d,n,t) (MEM_WRAP_CHECK_(n,t) (void)memmove((char*)(d),(const char*)(s), (n) * sizeof(t)))
+#define Copy(s,d,n,t) (MEM_WRAP_CHECK_(n,t) (void)memcpy((char*)(d),(const char*)(s), (n) * sizeof(t)))
+#define Zero(d,n,t) (MEM_WRAP_CHECK_(n,t) (void)memzero((char*)(d), (n) * sizeof(t)))
+#define MoveD(s,d,n,t) (MEM_WRAP_CHECK_(n,t) memmove((char*)(d),(const char*)(s), (n) * sizeof(t)))
+#define CopyD(s,d,n,t) (MEM_WRAP_CHECK_(n,t) memcpy((char*)(d),(const char*)(s), (n) * sizeof(t)))
+#ifdef HAS_MEMSET
+#define ZeroD(d,n,t) (MEM_WRAP_CHECK_(n,t) memzero((char*)(d), (n) * sizeof(t)))
+#else
+/* Using bzero(), which returns void. */
+#define ZeroD(d,n,t) (MEM_WRAP_CHECK_(n,t) memzero((char*)(d), (n) * sizeof(t)),d)
#endif
-#else /* lint */
-
-#define New(x,v,n,s) (v = Null(s *))
-#define Newc(x,v,n,s,c) (v = Null(s *))
-#define Newz(x,v,n,s) (v = Null(s *))
-#define Renew(v,n,s) (v = Null(s *))
-#define Move(s,d,n,t)
-#define Copy(s,d,n,t)
-#define Zero(d,n,t)
-#define MoveD(s,d,n,t) d
-#define CopyD(s,d,n,t) d
-#define ZeroD(d,n,t) d
-#define Poison(d,n,t)
-#define Safefree(d) (d) = (d)
-
-#endif /* lint */
+#define Poison(d,n,t) (MEM_WRAP_CHECK_(n,t) (void)memset((char*)(d), 0xAB, (n) * sizeof(t)))
#ifdef USE_STRUCT_COPY
#define StructCopy(s,d,t) (*((t*)(d)) = *((t*)(s)))
#ifdef USE_ITHREADS
#define pTHX_FORMAT "Perl interpreter: 0x%p"
#define pTHX__FORMAT ", Perl interpreter: 0x%p"
-#define pTHX_VALUE_ (unsigned long)my_perl,
-#define pTHX_VALUE (unsigned long)my_perl
-#define pTHX__VALUE_ ,(unsigned long)my_perl,
-#define pTHX__VALUE ,(unsigned long)my_perl
+#define pTHX_VALUE_ (void *)my_perl,
+#define pTHX_VALUE (void *)my_perl
+#define pTHX__VALUE_ ,(void *)my_perl,
+#define pTHX__VALUE ,(void *)my_perl
#else
-#define pTHX_FORMAT
+#define pTHX_FORMAT
#define pTHX__FORMAT
-#define pTHX_VALUE_
+#define pTHX_VALUE_
#define pTHX_VALUE
-#define pTHX__VALUE_
+#define pTHX__VALUE_
#define pTHX__VALUE
#endif /* USE_ITHREADS */
+
https://perl5.git.perl.org / perl5.git / blobdiff