/* handy.h
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1999,
- * 2000, 2001, 2002, 2004, 2005 by Larry Wall and others
+ * 2000, 2001, 2002, 2004, 2005, 2006, 2007, 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.
#endif
#endif
-#define Null(type) ((type)NULL)
+#ifndef PERL_CORE
+# define Null(type) ((type)NULL)
/*
=head1 Handy Values
-=for apidoc AmU||Nullch
-Null character pointer.
+=for apidoc AmU||Nullch
+Null character pointer. (No longer available when C<PERL_CORE> is defined.)
=for apidoc AmU||Nullsv
-Null SV pointer.
+Null SV pointer. (No longer available when C<PERL_CORE> is defined.)
=cut
*/
-#define Nullch Null(char*)
-#define Nullfp Null(PerlIO*)
-#define Nullsv Null(SV*)
+# define Nullch Null(char*)
+# define Nullfp Null(PerlIO*)
+# define Nullsv Null(SV*)
+#endif
#ifdef TRUE
#undef TRUE
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
#endif
/* Try to figure out __func__ or __FUNCTION__ equivalent, if any.
- * XXX Should really be a Configure probe. */
+ * 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. */
+ (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. */
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
/* HMB H.Merijn Brand - a placeholder for preparing Configure patches */
-#if defined(LIBM_LIB_VERSION)
+#if defined(LOCALTIME_R_NEEDS_TZSET) && defined(HAS_PSEUDOFORK) && defined(USE_DTRACE) && defined(GMTIME_MAX) && defined(GMTIME_MIN) && defined(HAS_TIMEGM)
/* Not (yet) used at top level, but mention them for metaconfig */
#endif
#define Ctl(ch) ((ch) & 037)
/*
+=head1 SV-Body Allocation
+
+=for apidoc Ama|SV*|newSVpvs|const char* s
+Like C<newSVpvn>, but takes a literal string instead of a string/length pair.
+
+=for apidoc Ama|SV*|newSVpvs_flags|const char* s|U32 flags
+Like C<newSVpvn_flags>, but takes a literal string instead of a string/length
+pair.
+
+=for apidoc Ama|SV*|newSVpvs_share|const char* s
+Like C<newSVpvn_share>, 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<sv_catpvn>, but takes a literal string instead of a string/length pair.
+
+=for apidoc Am|void|sv_setpvs|SV* sv|const char* s
+Like C<sv_setpvn>, but takes a literal string instead of a string/length pair.
+
+=head1 Memory Management
+
+=for apidoc Ama|char*|savepvs|const char* s
+Like C<savepvn>, 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<gv_stashpvn>, 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<hv_fetch>, 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<hv_store>, 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_flags(str,flags) \
+ Perl_newSVpvn_flags(aTHX_ STR_WITH_LEN(str), flags)
+#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) \
+ ((SV **)Perl_hv_common(aTHX_ (hv), NULL, STR_WITH_LEN(key), 0, \
+ (lval) ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) \
+ : HV_FETCH_JUST_SV, NULL, 0))
+
+#define hv_stores(hv,key,val) \
+ ((SV **)Perl_hv_common(aTHX_ (hv), NULL, STR_WITH_LEN(key), 0, \
+ (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), (val), 0))
+
+
+/*
=head1 Miscellaneous Functions
=for apidoc Am|bool|strNE|char* s1|char* s2
# define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
#endif
+#define memEQs(s1, l, s2) \
+ (sizeof(s2)-1 == l && memEQ(s1, (s2 ""), (sizeof(s2)-1)))
+#define memNEs(s1, l, s2) !memEQs(s1, l, s2)
+
/*
* Character classes.
*
# define isASCII(c) ((c) <= 127)
# define isCNTRL(c) ((c) < ' ' || (c) == 127)
# define isGRAPH(c) (isALNUM(c) || isPUNCT(c))
-# define isPRINT(c) (((c) > 32 && (c) < 127) || (c) == ' ')
+# define isPRINT(c) (((c) >= 32 && (c) < 127))
# define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
# define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
# define toUPPER(c) (isLOWER(c) ? (c) - ('a' - 'A') : (c))
# 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))
/*
-=head1 SV Manipulation Functions
-
-=for apidoc Am|SV*|NEWSV|int id|STRLEN len
-Creates a new SV. A non-zero C<len> 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<id> is an integer id between 0 and 1299 (used to identify leaks).
-
=head1 Memory Management
=for apidoc Am|void|Newx|void* ptr|int nitems|type
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,
+themselves. This aid has been superseded 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|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 */
+/* Maintained for backwards-compatibility only. Use newSV() instead. */
+#ifndef PERL_CORE
#define NEWSV(x,len) newSV(len)
+#endif
+
+#define MEM_SIZE_MAX ((MEM_SIZE)~0)
+/* The +0.0 in MEM_WRAP_CHECK_ is an attempt to foil
+ * overly eager compilers that will bleat about e.g.
+ * (U16)n > (size_t)~0/sizeof(U16) always being false. */
#ifdef PERL_MALLOC_WRAP
-#define MEM_WRAP_CHECK(n,t) \
- (void)((sizeof(t)>1?(n):1)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(PL_memory_wrap),0):0)
+#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?(n):1)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(a),0):0)
-#define MEM_WRAP_CHECK_2(n,t,a,b) \
- (void)((sizeof(t)>1?(n):1)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(a,b),0):0)
+ (void)(sizeof(t) > 1 && ((MEM_SIZE)(n)+0.0) > MEM_SIZE_MAX/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)))
+#define PERL_STRLEN_ROUNDUP(n) ((void)(((n) > MEM_SIZE_MAX - 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
* 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) passed in. This can then be used for logging the calls,
- * for which one can get a sample implementation if PERL_MEM_LOG_STDERR
- * is defined.
- *
+ * 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
#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))
+#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,c) Newxz(v,n,t,c)
+#define Newz(x,v,n,t) Newxz(v,n,t)
+#endif
#define Renew(v,n,t) \
(v = (MEM_WRAP_CHECK_(n,t) MEM_LOG_REALLOC(n,t,v,(t*)saferealloc((Malloc_t)(v),(MEM_SIZE)((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)
+ ((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
#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 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)))
#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 */
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */