X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/c302d089fd60667af8cc69b142a3170e60b81b9e..834df1c59777570a74dbdc390d6beedbd3d1e56c:/handy.h diff --git a/handy.h b/handy.h index 88d7b13..f88af3e 100644 --- a/handy.h +++ b/handy.h @@ -1,7 +1,7 @@ /* handy.h * * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1999, - * 2000, 2001, 2002, by Larry Wall and others + * 2000, 2001, 2002, 2004, 2005, 2006, 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. @@ -24,7 +24,7 @@ /* =head1 Handy Values -=for apidoc AmU||Nullch +=for apidoc AmU||Nullch Null character pointer. =for apidoc AmU||Nullsv @@ -59,7 +59,7 @@ Null SV pointer. 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 @@ -87,6 +87,21 @@ Null SV pointer. # 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. @@ -107,11 +122,11 @@ Null SV pointer. 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). @@ -159,6 +174,11 @@ typedef U64TYPE U64; # endif #endif +/* HMB H.Merijn Brand - a placeholder for preparing Configure patches */ +#if defined(HAS_MALLOC_SIZE) && defined(HAS_SNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) +/* Not (yet) used at top level, but mention them for metaconfig */ +#endif + /* Mention I8SIZE, U8SIZE, I16SIZE, U16SIZE, I32SIZE, U32SIZE, I64SIZE, and U64SIZE here so that metaconfig pulls them in. */ @@ -217,6 +237,64 @@ typedef U64TYPE U64; #define Ctl(ch) ((ch) & 037) /* +=head1 SV-Body Allocation + +=for apidoc Ama|SV*|newSVpvs|const char* s +Like C, but takes a literal string instead of a string/length pair. + +=for apidoc Ama|SV*|newSVpvs_share|const char* s +Like C, but takes a literal string instead of a string/length +pair and omits the hash parameter. + +=for apidoc Am|void|sv_catpvs|SV* sv|const char* s +Like C, but takes a literal string instead of a string/length pair. + +=for apidoc Am|void|sv_setpvs|SV* sv|const char* s +Like C, but takes a literal string instead of a string/length pair. + +=head1 Memory Management + +=for apidoc Ama|char*|savepvs|const char* s +Like C, but takes a literal string instead of a string/length pair. + +=head1 GV Functions + +=for apidoc Am|HV*|gv_stashpvs|const char* name|I32 create +Like C, but takes a literal string instead of a string/length pair. + +=head1 Hash Manipulation Functions + +=for apidoc Am|SV**|hv_fetchs|HV* tb|const char* key|I32 lval +Like C, but takes a literal string instead of a string/length pair. + +=for apidoc Am|SV**|hv_stores|HV* tb|const char* key|NULLOK SV* val +Like C, but takes a literal string instead of a string/length pair +and omits the hash parameter. + +=cut +*/ + +/* concatenating with "" ensures that only literal strings are accepted as argument */ +#define STR_WITH_LEN(s) (s ""), (sizeof(s)-1) + +/* note that STR_WITH_LEN() can't be used as argument to macros or functions that + * under some configurations might be macros, which means that it requires the full + * Perl_xxx(aTHX_ ...) form for any API calls where it's used. + */ + +/* STR_WITH_LEN() shortcuts */ +#define newSVpvs(str) Perl_newSVpvn(aTHX_ STR_WITH_LEN(str)) +#define newSVpvs_share(str) Perl_newSVpvn_share(aTHX_ STR_WITH_LEN(str), 0) +#define sv_catpvs(sv, str) Perl_sv_catpvn_flags(aTHX_ sv, STR_WITH_LEN(str), SV_GMAGIC) +#define sv_setpvs(sv, str) Perl_sv_setpvn(aTHX_ sv, STR_WITH_LEN(str)) +#define savepvs(str) Perl_savepvn(aTHX_ STR_WITH_LEN(str)) +#define gv_stashpvs(str, create) Perl_gv_stashpvn(aTHX_ STR_WITH_LEN(str), create) +#define gv_fetchpvs(namebeg, add, sv_type) Perl_gv_fetchpvn_flags(aTHX_ STR_WITH_LEN(namebeg), add, sv_type) +#define hv_fetchs(hv,key,lval) Perl_hv_fetch(aTHX_ hv, STR_WITH_LEN(key), lval) +#define hv_stores(hv,key,val) Perl_hv_store(aTHX_ hv, STR_WITH_LEN(key), val, 0) + + +/* =head1 Miscellaneous Functions =for apidoc Am|bool|strNE|char* s1|char* s2 @@ -402,7 +480,7 @@ Converts the specified character to lowercase. # 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)) @@ -514,35 +592,28 @@ Converts the specified character to lowercase. /* 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 SV Manipulation Functions - -=for apidoc Am|SV*|NEWSV|int id|STRLEN len -Creates a new SV. A non-zero C parameter indicates the number of -bytes of preallocated string space the SV should have. An extra byte for a -tailing NUL is also reserved. (SvPOK is not set for the SV even if string -space is allocated.) The reference count for the new SV is set to 1. -C is an integer id between 0 and 1299 (used to identify leaks). - =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 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, a debug aid which allowed callers to identify +themselves. This aid has been superseded by a new build option, +PERL_MEM_LOG (see L). 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 function, with -cast. +cast. See also C. -=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 function. The allocated -memory is zeroed with C. +memory is zeroed with C. See also C. =for apidoc Am|void|Renew|void* ptr|int nitems|type The XSUB-writer's interface to the C C function. @@ -559,59 +630,171 @@ The XSUB-writer's interface to the C C function. The C is the source, C is the destination, C is the number of items, and C is the type. Can do overlapping moves. See also C. +=for apidoc Am|void *|MoveD|void* src|void* dest|int nitems|type +Like C but returns dest. Useful for encouraging compilers to tail-call +optimise. + =for apidoc Am|void|Copy|void* src|void* dest|int nitems|type The XSUB-writer's interface to the C C function. The C is the source, C is the destination, C is the number of items, and C is the type. May fail on overlapping copies. See also C. +=for apidoc Am|void *|CopyD|void* src|void* dest|int nitems|type + +Like C but returns dest. Useful for encouraging compilers to tail-call +optimise. + =for apidoc Am|void|Zero|void* dest|int nitems|type The XSUB-writer's interface to the C C function. The C is the destination, C is the number of items, and C is the type. +=for apidoc Am|void *|ZeroD|void* dest|int nitems|type + +Like C but returns dest. Useful for encouraging compilers to tail-call +optimise. + =for apidoc Am|void|StructCopy|type src|type dest|type This is an architecture-independent macro to copy one structure to another. +=for apidoc Am|void|PoisonWith|void* dest|int nitems|type|U8 byte + +Fill up memory with a byte pattern (a byte repeated over and over +again) that hopefully catches attempts to access uninitialized memory. + +=for apidoc Am|void|PoisonNew|void* dest|int nitems|type + +PoisonWith(0xAB) for catching access to allocated but uninitialized memory. + +=for apidoc Am|void|PoisonFree|void* dest|int nitems|type + +PoisonWith(0xEF) for catching access to freed memory. + =for apidoc Am|void|Poison|void* dest|int nitems|type -Fill up memory with a pattern (byte 0xAB over and over again) that -hopefully catches attempts to access uninitialized memory. +PoisonWith(0xEF) for catching access to freed memory. =cut */ -#ifndef lint - +/* Maintained for backwards-compatibility only. Use newSV() instead. */ +#ifndef PERL_CORE #define NEWSV(x,len) newSV(len) +#endif + +#ifdef PERL_MALLOC_WRAP +#define MEM_WRAP_CHECK(n,t) MEM_WRAP_CHECK_1(n,t,PL_memory_wrap) +#define MEM_WRAP_CHECK_1(n,t,a) \ + (void)(sizeof(t) > 1 && (MEM_SIZE)(n) > ((MEM_SIZE)~0)/sizeof(t) && (Perl_croak_nocontext(a),0)) +#define MEM_WRAP_CHECK_(n,t) MEM_WRAP_CHECK(n,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 + +#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*)safecalloc((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 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)))), \ - memzero((char*)(v), (n)*sizeof(t)) #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)) + (v = (MEM_WRAP_CHECK_(n,t) MEM_LOG_REALLOC(n,t,v,(c*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))))) -#define Move(s,d,n,t) (void)memmove((char*)(d),(char*)(s), (n) * sizeof(t)) -#define Copy(s,d,n,t) (void)memcpy((char*)(d),(char*)(s), (n) * sizeof(t)) -#define Zero(d,n,t) (void)memzero((char*)(d), (n) * sizeof(t)) - -#define Poison(d,n,t) (void)memset((char*)(d), 0xAB, (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 Safefree(d) safefree(MEM_LOG_FREE((Malloc_t)(d))) +#endif -#else /* lint */ +#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 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 Poison(d,n,t) -#define Safefree(d) (d) = (d) +#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 -#endif /* lint */ +#define PoisonWith(d,n,t,b) (MEM_WRAP_CHECK_(n,t) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))) +#define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB) +#define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF) +#define Poison(d,n,t) PoisonFree(d,n,t) #ifdef USE_STRUCT_COPY #define StructCopy(s,d,t) (*((t*)(d)) = *((t*)(s))) @@ -633,3 +816,20 @@ hopefully catches attempts to access uninitialized memory. # endif #endif +/* convenience debug macros */ +#ifdef USE_ITHREADS +#define pTHX_FORMAT "Perl interpreter: 0x%p" +#define pTHX__FORMAT ", Perl interpreter: 0x%p" +#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_VALUE_ +#define pTHX_VALUE +#define pTHX__VALUE_ +#define pTHX__VALUE +#endif /* USE_ITHREADS */ +