Reinstate PERL_MALLOC_WRAP for bcc32 on Win32
[p5sagit/p5-mst-13.2.git] / perl.h
diff --git a/perl.h b/perl.h
index 1a2145c..63eba70 100644 (file)
--- a/perl.h
+++ b/perl.h
 #define CALLREGFREE CALL_FPTR(PL_regfree)
 
 #if defined(SYMBIAN) && defined(__GNUC__)
-#  undef __attribute__
-#  undef __attribute__(_arg_)
-#  define HASATTRIBUTE
-#endif
-
-#ifdef HASATTRIBUTE
-#  if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
+#  ifdef __cplusplus
 #    define PERL_UNUSED_DECL
 #  else
 #    define PERL_UNUSED_DECL __attribute__((unused))
 #  endif
-#else
-#  define PERL_UNUSED_DECL
-#endif
-#if defined(SYMBIAN) && defined(__GNUC__)
-#  undef __attribute__
-#  undef __attribute__(_arg_)
-#  define HASATTRIBUTE
 #endif
 
+#ifndef PERL_UNUSED_DECL
+#  ifdef HASATTRIBUTE_UNUSED
+#    define PERL_UNUSED_DECL __attribute__unused__
+#  else
+#    define PERL_UNUSED_DECL
+#  endif
+#endif
 /* gcc -Wall:
  * for silencing unused variables that are actually used most of the time,
- * but we cannot quite get rid of, such `ax' in PPCODE+noargs xsubs
+ * but we cannot quite get rid of, such as "ax" in PPCODE+noargs xsubs
  */
-#define PERL_UNUSED_VAR(var) ((void)var)
+#ifndef PERL_UNUSED_ARG
+#  ifdef lint
+#    include <note.h>
+#    define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
+#  else
+#    define PERL_UNUSED_ARG(x) ((void)x)
+#  endif
+#endif
+#ifndef PERL_UNUSED_VAR
+#  define PERL_UNUSED_VAR(x) ((void)x)
+#endif
 
 #define NOOP (void)0
 #define dNOOP extern int Perl___notused PERL_UNUSED_DECL
@@ -326,7 +330,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
  */
 #if !(defined(STMT_START) && defined(STMT_END))
 # if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
-#   define STMT_START  (void)( /* gcc supports ``({ STATEMENTS; })'' */
+#   define STMT_START  (void)( /* gcc supports "({ STATEMENTS; })" */
 #   define STMT_END    )
 # else
    /* Now which other defined()s do we need here ??? */
@@ -800,6 +804,12 @@ int usleep(unsigned int);
 
 #endif /* PERL_CORE */
 
+/* We no longer default to creating a new SV for GvSV.
+   Do this before embed.  */
+#ifndef PERL_CREATE_GVSV
+#define PERL_DONT_CREATE_GVSV
+#endif
+
 /* Cannot include embed.h here on Win32 as win32.h has not 
    yet been included and defines some config variables e.g. HAVE_INTERP_INTERN
  */
@@ -809,6 +819,13 @@ int usleep(unsigned int);
 
 #define MEM_SIZE Size_t
 
+/* Round all values passed to malloc up, by default to a multiple of
+   sizeof(size_t)
+*/
+#ifndef PERL_STRLEN_ROUNDUP_QUANTUM
+#define PERL_STRLEN_ROUNDUP_QUANTUM Size_t_size
+#endif
+
 #if defined(STANDARD_C) && defined(I_STDDEF)
 #   include <stddef.h>
 #   define STRUCT_OFFSET(s,m)  offsetof(s,m)
@@ -1115,7 +1132,8 @@ int sockatmark(int);
 #endif
 
 #define ERRSV GvSV(PL_errgv)
-#define DEFSV GvSV(PL_defgv)
+/* FIXME? Change the assignments to PL_defgv to instantiate GvSV?  */
+#define DEFSV GvSVn(PL_defgv)
 #define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
 
 #define ERRHV GvHV(PL_errgv)   /* XXX unused, here for compatibility */
@@ -1494,6 +1512,19 @@ typedef UVTYPE UV;
 #  define PTR2ul(p)    INT2PTR(unsigned long,p)        
 #endif
 
+/* According to strict ANSI C89 one cannot freely cast between
+ * data pointers and function (code) pointers.  There are at least
+ * two ways around this.  One (used below) is to do two casts,
+ * first the other pointer to an (unsigned) integer, and then
+ * the integer to the other pointer.  The other way would be
+ * to use unions to "overlay" the pointers.  For an example of
+ * the latter technique, see union dirpu in struct xpvio in sv.h.
+ * The only feasible use is probably temporarily storing
+ * function pointers in a data pointer (such as a void pointer). */
+
+#define DPTR2FPTR(t,p) ((t)(PTRV)(p)) /* data pointer to function pointer */
+#define FPTR2DPTR(t,p) ((t)(PTRV)(p)) /* function pointer to data pointer */
+
 #ifdef USE_LONG_DOUBLE
 #  if defined(HAS_LONG_DOUBLE) && LONG_DOUBLESIZE == DOUBLESIZE
 #      define LONG_DOUBLE_EQUALS_DOUBLE
@@ -2107,7 +2138,6 @@ typedef struct context PERL_CONTEXT;
 typedef struct block BLOCK;
 
 typedef struct magic MAGIC;
-typedef struct xrv XRV;
 typedef struct xpv XPV;
 typedef struct xpviv XPVIV;
 typedef struct xpvuv XPVUV;
@@ -2301,6 +2331,64 @@ typedef struct clone_params CLONE_PARAMS;
 #   define ISHISH "unix"
 #endif
 
+/* NSIG logic from Configure --> */
+/* Strange style to avoid deeply-nested #if/#else/#endif */
+#ifndef NSIG
+#  ifdef _NSIG
+#    define NSIG (_NSIG)
+#  endif
+#endif
+
+#ifndef NSIG
+#  ifdef SIGMAX
+#    define NSIG (SIGMAX+1)
+#  endif
+#endif
+
+#ifndef NSIG
+#  ifdef SIG_MAX
+#    define NSIG (SIG_MAX+1)
+#  endif
+#endif
+
+#ifndef NSIG
+#  ifdef _SIG_MAX
+#    define NSIG (_SIG_MAX+1)
+#  endif
+#endif
+
+#ifndef NSIG
+#  ifdef MAXSIG
+#    define NSIG (MAXSIG+1)
+#  endif
+#endif
+
+#ifndef NSIG
+#  ifdef MAX_SIG
+#    define NSIG (MAX_SIG+1)
+#  endif
+#endif
+
+#ifndef NSIG
+#  ifdef SIGARRAYSIZE
+#    define NSIG SIGARRAYSIZE /* Assume ary[SIGARRAYSIZE] */
+#  endif
+#endif
+
+#ifndef NSIG
+#  ifdef _sys_nsig
+#    define NSIG (_sys_nsig) /* Solaris 2.5 */
+#  endif
+#endif
+
+/* Default to some arbitrary number that's big enough to get most
+   of the common signals.
+*/
+#ifndef NSIG
+#    define NSIG 50
+#endif
+/* <-- NSIG logic from Configure */
+
 #ifndef NO_ENVIRON_ARRAY
 #  define USE_ENVIRON_ARRAY
 #endif
@@ -2316,7 +2404,7 @@ typedef struct clone_params CLONE_PARAMS;
 #    define PERL_FPU_INIT fpsetmask(0);
 #  else
 #    if defined(SIGFPE) && defined(SIG_IGN) && !defined(PERL_MICRO)
-#      define PERL_FPU_INIT       PL_sigfpe_saved = signal(SIGFPE, SIG_IGN);
+#      define PERL_FPU_INIT       PL_sigfpe_saved = (Sighandler_t) signal(SIGFPE, SIG_IGN);
 #      define PERL_FPU_PRE_EXEC   { Sigsave_t xfpe; rsignal_save(SIGFPE, PL_sigfpe_saved, &xfpe);
 #      define PERL_FPU_POST_EXEC    rsignal_restore(SIGFPE, &xfpe); }
 #    else
@@ -2363,6 +2451,41 @@ typedef struct clone_params CLONE_PARAMS;
 #  endif
 #endif
 
+/* In case Configure was not used (we are using a "canned config"
+ * such as Win32, or a cross-compilation setup, for example) try going
+ * by the gcc major and minor versions.  One useful URL is
+ * http://www.ohse.de/uwe/articles/gcc-attributes.html,
+ * but contrary to this information warn_unused_result seems
+ * not to be in gcc 3.3.5, at least. --jhi
+ * Set these up now otherwise we get confused when some of the <*thread.h>
+ * includes below indirectly pull in <perlio.h> (which needs to know if we
+ * have HASATTRIBUTE_FORMAT).
+ */
+
+#if defined __GNUC__
+#  if __GNUC__ >= 3 /* 3.0 -> */ /* XXX Verify this version */
+#    define HASATTRIBUTE_FORMAT
+#  endif
+#  if __GNUC__ >= 3 /* 3.0 -> */
+#    define HASATTRIBUTE_MALLOC
+#  endif
+#  if __GNUC__ == 3 && __GNUC_MINOR__ >= 3 || __GNUC__ > 3 /* 3.3 -> */
+#    define HASATTRIBUTE_NONNULL
+#  endif
+#  if __GNUC__ == 2 && __GNUC_MINOR__ >= 5 || __GNUC__ > 2 /* 2.5 -> */
+#    define HASATTRIBUTE_NORETURN
+#  endif
+#  if __GNUC__ >= 3 /* gcc 3.0 -> */
+#    define HASATTRIBUTE_PURE
+#  endif
+#  if __GNUC__ >= 3 /* gcc 3.0 -> */ /* XXX Verify this version */
+#    define HASATTRIBUTE_UNUSED
+#  endif
+#  if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */
+#    define HASATTRIBUTE_WARN_UNUSED_RESULT
+#  endif
+#endif
+
 /* USE_5005THREADS needs to be after unixish.h as <pthread.h> includes
  * <sys/signal.h> which defines NSIG - which will stop inclusion of <signal.h>
  * this results in many functions being undeclared which bothers C++
@@ -2550,28 +2673,49 @@ typedef pthread_key_t   perl_key;
 #  define PERL_SET_THX(t)              PERL_SET_CONTEXT(t)
 #endif
 
-#ifndef SVf
-#  ifdef CHECK_FORMAT
-#    define SVf "-p"
-#  else
-#    define SVf "_"
-#  endif
+/* 
+    This replaces the previous %_ "hack" by the "%p" hacks.
+    All that is required is that the perl source does not
+    use "%-p" or "%-<number>p" or "%<number>p" formats.  
+    These formats will still work in perl code.   
+    See comments in sv.c for futher details.
+
+       -DvdNUMBER=<number> can be used to redefine VDf
+
+       -DvdNUMBER=0 reverts VDf to "vd", as in perl5.8.7,
+           which works properly but gives compiler warnings
+
+    Robin Barker 2005-07-14
+*/
+
+#ifndef SVf_
+#  define SVf_(n) "-" #n "p"
 #endif
 
-#ifndef SVf_precision
-#  ifdef CHECK_FORMAT
-#    define SVf_precision(n) "-" n "p"
-#  else
-#    define SVf_precision(n) "." n "_"
-#  endif
+#ifndef SVf
+#  define SVf "-p"
 #endif
 
 #ifndef SVf32
-#  define SVf32 SVf_precision("32")
+#  define SVf32 SVf_(32)
 #endif
 
 #ifndef SVf256
-#  define SVf256 SVf_precision("256")
+#  define SVf256 SVf_(256)
+#endif
+
+#ifndef vdNUMBER
+#  define vdNUMBER 1
+#endif
+#ifndef VDf
+#  if vdNUMBER 
+#    define vdFORMAT(n) #n "p"
+#    define VDf_(n) vdFORMAT(n)
+#    define VDf VDf_(vdNUMBER)
+#  else
+#    define VDf "vd"
+#  endif
 #endif
  
 #ifndef UVf
@@ -2579,41 +2723,35 @@ typedef pthread_key_t   perl_key;
 #endif
 
 #ifndef DieNull
-#  ifdef CHECK_FORMAT
-#    define DieNull Perl_vdie(aTHX_ Nullch, Null(va_list *))
-#  else
-#    define DieNull Perl_die(aTHX_ Nullch)
-#  endif
+#  define DieNull Perl_vdie(aTHX_ Nullch, Null(va_list *))
 #endif
 
-#ifndef __attribute__format__
-#  ifdef CHECK_FORMAT
-#    define __attribute__format__(x,y,z) __attribute__((format(x,y,z)))
-#  else
-#    define __attribute__format__(x,y,z)
-#  endif
+#ifdef HASATTRIBUTE_FORMAT
+#  define __attribute__format__(x,y,z)      __attribute__((format(x,y,z)))
 #endif
-
-/* See http://www.ohse.de/uwe/articles/gcc-attributes.html, but
- * contrary to the information warn_unused_result seems not to be in
- * gcc 3.3.5, at least. --jhi */
-
-#if __GNUC__ >= 3
-#  define __attribute__malloc__             __attribute__((malloc))
+#ifdef HASATTRIBUTE_MALLOC
+#  define __attribute__malloc__             __attribute__((__malloc__))
 #endif
-#if __GNUC__ == 3 && __GNUC_MINOR__ >= 3 || __GNUC__ > 3
+#ifdef HASATTRIBUTE_NONNULL
 #  define __attribute__nonnull__(a)         __attribute__((nonnull(a)))
 #endif
-#if __GNUC__ == 2 && __GNUC_MINOR__ >= 5 || __GNUC__ > 2
+#ifdef HASATTRIBUTE_NORETURN
 #  define __attribute__noreturn__           __attribute__((noreturn))
 #endif
-#if __GNUC__ >= 3
+#ifdef HASATTRIBUTE_PURE
 #  define __attribute__pure__               __attribute__((pure))
 #endif
-#if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3
+#ifdef HASATTRIBUTE_UNUSED
+#  define __attribute__unused__             __attribute__((unused))
+#endif
+#ifdef HASATTRIBUTE_WARN_UNUSED_RESULT
 #  define __attribute__warn_unused_result__ __attribute__((warn_unused_result))
 #endif
 
+/* If we haven't defined the attributes yet, define them to blank. */
+#ifndef __attribute__format__
+#  define __attribute__format__(x,y,z)
+#endif
 #ifndef __attribute__malloc__
 #  define __attribute__malloc__
 #endif
@@ -2626,12 +2764,20 @@ typedef pthread_key_t   perl_key;
 #ifndef __attribute__pure__
 #  define __attribute__pure__
 #endif
+#ifndef __attribute__unused__
+#  define __attribute__unused__
+#endif
 #ifndef __attribute__warn_unused_result__
 #  define __attribute__warn_unused_result__
 #endif
 
-#if defined(HASATTRIBUTE) && __GNUC__ >= 3
-#  define HASATTRIBUTE_NORETURN
+/* For functions that are marked as __attribute__noreturn__, it's not
+   appropriate to call return.  In either case, include the lint directive.
+ */
+#ifdef HASATTRIBUTE_NORETURN
+#  define NORETURN_FUNCTION_END /* NOT REACHED */
+#else
+#  define NORETURN_FUNCTION_END /* NOT REACHED */ return 0
 #endif
 
 /* Some unistd.h's give a prototype for pause() even though
@@ -2768,9 +2914,12 @@ struct regnode_charclass_class;  /* Used in S_* functions in regcomp.c */
 
 typedef I32 CHECKPOINT;
 
+/* Keep next first in this structure, because sv_free_arenas take
+   advantage of this to share code between the pte arenas and the SV
+   body arenas  */
 struct ptr_tbl_ent {
     struct ptr_tbl_ent*                next;
-    void*                      oldval;
+    const void*                        oldval;
     void*                      newval;
 };
 
@@ -3159,14 +3308,17 @@ Gid_t getegid (void);
 #define PERL_MAGIC_arylen        '#' /* Array length ($#ary) */
 #define PERL_MAGIC_pos           '.' /* pos() lvalue */
 #define PERL_MAGIC_backref       '<' /* for weak ref data */
+#define PERL_MAGIC_symtab        ':' /* extra data for symbol tables */
+#define PERL_MAGIC_rhash         '%' /* extra data for restricted hashes */
+#define PERL_MAGIC_arylen_p      '@' /* to move arylen out of XPVAV */
 #define PERL_MAGIC_ext           '~' /* Available for use by extensions */
 
 
 #ifndef assert  /* <assert.h> might have been included somehow */
 #define assert(what)   PERL_DEB(                                       \
        ((what) ? ((void) 0) :                                          \
-           (Perl_croak(aTHX_ "Assertion " STRINGIFY(what) " failed: file \"%s\", line %d",     \
-               __FILE__, __LINE__),                                    \
+           (Perl_croak(aTHX_ "Assertion %s failed: file \"" __FILE__   \
+                       "\", line %d", STRINGIFY(what), __LINE__),      \
            PerlProc_exit(1),                                           \
            (void) 0)))
 #endif
@@ -3758,7 +3910,9 @@ enum {            /* pass one of these to get_vtbl */
     want_vtbl_regdata,
     want_vtbl_regdatum,
     want_vtbl_backref,
-    want_vtbl_utf8
+    want_vtbl_utf8,
+    want_vtbl_symtab,
+    want_vtbl_arylen_p
 };
 
                                /* Note: the lowest 8 bits are reserved for
@@ -3928,20 +4082,10 @@ struct tempsym; /* defined in pp_pack.c */
 #ifndef PERL_CALLCONV
 #  define PERL_CALLCONV
 #endif
-
-#ifndef NEXT30_NO_ATTRIBUTE
-#  ifndef HASATTRIBUTE       /* disable GNU-cc attribute checking? */
-#    ifdef  __attribute__      /* Avoid possible redefinition errors */
-#      undef  __attribute__
-#    endif
-#    define __attribute__(attr)
-#  endif
-#endif
-
 #undef PERL_CKDEF
 #undef PERL_PPDEF
-#define PERL_CKDEF(s)  OP *s (pTHX_ OP *o);
-#define PERL_PPDEF(s)  OP *s (pTHX);
+#define PERL_CKDEF(s)  PERL_CALLCONV OP *s (pTHX_ OP *o);
+#define PERL_PPDEF(s)  PERL_CALLCONV OP *s (pTHX);
 
 #include "proto.h"
 
@@ -3994,8 +4138,10 @@ START_EXTERN_C
 
 #ifdef DOINIT
 #  define MGVTBL_SET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var = {a,b,c,d,e,f,g}
+#  define MGVTBL_SET_CONST_MAGIC_GET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var = {(int (*)(pTHX_ SV *, MAGIC *))a,b,c,d,e,f,g} /* Like MGVTBL_SET but with the get magic having a const MG* */
 #else
 #  define MGVTBL_SET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var
+#  define MGVTBL_SET_CONST_MAGIC_GET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var
 #endif
 
 MGVTBL_SET(
@@ -4116,7 +4262,7 @@ MGVTBL_SET(
     NULL
 );
 
-MGVTBL_SET(
+MGVTBL_SET_CONST_MAGIC_GET(
     PL_vtbl_arylen,
     MEMBER_TO_FPTR(Perl_magic_getarylen),
     MEMBER_TO_FPTR(Perl_magic_setarylen),
@@ -4128,6 +4274,17 @@ MGVTBL_SET(
 );
 
 MGVTBL_SET(
+    PL_vtbl_arylen_p,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    MEMBER_TO_FPTR(Perl_magic_freearylen_p),
+    NULL,
+    NULL
+);
+
+MGVTBL_SET(
     PL_vtbl_glob,
     MEMBER_TO_FPTR(Perl_magic_getglob),
     MEMBER_TO_FPTR(Perl_magic_setglob),
@@ -4686,26 +4843,6 @@ typedef struct am_table_short AMTS;
 #define PERL_ALLOC_CHECK(p)  NOOP
 #endif
 
-/*
- * nice_chunk and nice_chunk size need to be set
- * and queried under the protection of sv_mutex
- */
-#define offer_nice_chunk(chunk, chunk_size) STMT_START {  \
-       void *new_chunk;                                   \
-       U32 new_chunk_size;                                \
-       LOCK_SV_MUTEX;                                     \
-       new_chunk = (void *)(chunk);                       \
-       new_chunk_size = (chunk_size);                     \
-       if (new_chunk_size > PL_nice_chunk_size) {         \
-           if (PL_nice_chunk) Safefree(PL_nice_chunk);    \
-           PL_nice_chunk = (char *) new_chunk;            \
-           PL_nice_chunk_size = new_chunk_size;           \
-       } else {                                           \
-           Safefree(chunk);                               \
-       }                                                  \
-       UNLOCK_SV_MUTEX;                                   \
-   } STMT_END
-
 #ifdef HAS_SEM
 #   include <sys/ipc.h>
 #   include <sys/sem.h>
@@ -5075,8 +5212,8 @@ extern void moncontrol(int);
  * but also beware since this evaluates its argument twice, so no x++. */
 #define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
 
-#ifdef __osf__
-#pragma message disable (mainparm) /* We have the envp in main(). */
+#if defined(__DECC) && defined(__osf__)
+#pragma message disable (mainparm) /* Perl uses the envp in main(). */
 #endif
 
 /* and finally... */