This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Don't test the core XS code yet with PERL_DEBUG_COW > 1
[perl5.git] / handy.h
diff --git a/handy.h b/handy.h
index 9bee70b..534e92e 100644 (file)
--- 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 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.
@@ -159,6 +159,11 @@ typedef U64TYPE U64;
 #   endif
 #endif
 
+/* HMB H.Merijn Brand - a placeholder for preparing Configure patches */
+#if defined(LIBM_LIB_VERSION)
+/* 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. */
 
@@ -357,7 +362,7 @@ Converts the specified character to lowercase.
 #   define isGRAPH(c)  (isALNUM(c) || isPUNCT(c))
 #   define isPRINT(c)  (((c) > 32 && (c) < 127) || (c) == ' ')
 #   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 isXDIGIT(c)  (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
 #   define toUPPER(c)  (isLOWER(c) ? (c) - ('a' - 'A') : (c))
 #   define toLOWER(c)  (isUPPER(c) ? (c) + ('a' - 'A') : (c))
 #endif
@@ -502,19 +507,19 @@ Converts the specified character to lowercase.
 #define isBLANK_LC_utf8(c)     isBLANK(c) /* could be wrong */
 
 #ifdef EBCDIC
-#  define toCTRL(c)    Perl_ebcdic_control(c)
+#  ifdef PERL_IMPLICIT_CONTEXT
+#    define toCTRL(c)     Perl_ebcdic_control(aTHX_ c)
+#  else
+#    define toCTRL        Perl_ebcdic_control
+#  endif
 #else
   /* This conversion works both ways, strangely enough. */
 #  define toCTRL(c)    (toUPPER(c) ^ 64)
 #endif
 
-/* Line numbers are unsigned, 16 bits. */
-typedef U16 line_t;
-#ifdef lint
-#define NOLINE ((line_t)0)
-#else
-#define NOLINE ((line_t) 65535)
-#endif
+/* Line numbers are unsigned, 32 bits. */
+typedef U32 line_t;
+#define NOLINE ((line_t) 4294967295UL)
 
 
 /*
@@ -555,16 +560,30 @@ The XSUB-writer's interface to the C C<memmove> function.  The C<src> is the
 source, C<dest> is the destination, C<nitems> is the number of items, and C<type> is
 the type.  Can do overlapping moves.  See also C<Copy>.
 
+=for apidoc Am|void *|MoveD|void* src|void* dest|int nitems|type
+Like C<Move> 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<memcpy> function.  The C<src> is the
 source, C<dest> is the destination, C<nitems> is the number of items, and C<type> is
 the type.  May fail on overlapping copies.  See also C<Move>.
 
+=for apidoc Am|void *|CopyD|void* src|void* dest|int nitems|type
+
+Like C<Copy> 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<memzero> function.  The C<dest> is the
 destination, C<nitems> is the number of items, and C<type> is the type.
 
+=for apidoc Am|void *|ZeroD|void* dest|int nitems|type
+
+Like C<Zero> 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.
 
@@ -575,39 +594,54 @@ hopefully catches attempts to access uninitialized memory.
 
 =cut */
 
-#ifndef lint
-
 #define NEWSV(x,len)   newSV(len)
 
-#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_MALLOC_WRAP
+#define MEM_WRAP_CHECK(n,t) \
+       (void)((n)>((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)
+#define MEM_WRAP_CHECK_2(n,t,a,b) \
+       (void)((n)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(a,b),0):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
+
+#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 = (t*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t))))
+         (v = (MEM_WRAP_CHECK_(n,t) (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))))
+         (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)  (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 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 Poison(d,n,t)  (void)memset((char*)(d), 0xAB, (n) * sizeof(t))
-
-#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 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 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)))
@@ -615,6 +649,8 @@ hopefully catches attempts to access uninitialized memory.
 #define StructCopy(s,d,t) Copy(s,d,1,t)
 #endif
 
+#define C_ARRAY_LENGTH(a)      (sizeof(a)/sizeof((a)[0]))
+
 #ifdef NEED_VA_COPY
 # ifdef va_copy
 #  define Perl_va_copy(s, d) va_copy(d, s)
@@ -627,3 +663,19 @@ 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 */