speeding up object creation/destruction 4x times

[p5sagit/p5-mst-13.2.git] / perl.h

diff --git a/perl.h b/perl.h
index 5724c3b..8313c07 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -183,7 +183,7 @@ class CPerlObj;
 struct perl_thread;
 #    define pTHX       register struct perl_thread *thr
 #    define aTHX       thr
-#    define dTHR       dNOOP
+#    define dTHR       dNOOP /* only backward compatibility */
 #    define dTHXa(a)   pTHX = (struct perl_thread*)a
 #  else
 #    ifndef MULTIPLICITY
@@ -303,7 +303,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
 #endif
 
 #define WITH_THX(s) STMT_START { dTHX; s; } STMT_END
-#define WITH_THR(s) STMT_START { dTHR; s; } STMT_END
+#define WITH_THR(s) WITH_THX(s)
 
 /*
  * SOFT_CAST can be used for args to prototyped functions to retain some
@@ -496,12 +496,16 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
 #   include <sys/param.h>
 #endif
 
-
 /* Use all the "standard" definitions? */
 #if defined(STANDARD_C) && defined(I_STDLIB)
 #   include <stdlib.h>
 #endif
 
+/* If this causes problems, set i_unistd=undef in the hint file.  */
+#ifdef I_UNISTD
+#   include <unistd.h>
+#endif
+
 #ifdef PERL_MICRO /* Last chance to export Perl_my_swap */
 #  define MYSWAP
 #endif
@@ -710,6 +714,10 @@ typedef struct perl_mstats perl_mstats_t;
 
 #include <errno.h>
 
+#if defined(WIN32) && (defined(PERL_OBJECT) || defined(PERL_IMPLICIT_SYS) || defined(PERL_CAPI))
+#  define WIN32SCK_IS_STDSCK           /* don't pull in custom wsock layer */
+#endif
+
 #if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
 # include <sys/socket.h>
 # if defined(USE_SOCKS) && defined(I_SOCKS)
@@ -2145,6 +2153,7 @@ Gid_t getegid (void);
 #  else
 #    define DEBUG_S(a)
 #  endif
+#define DEBUG_T(a) if (PL_debug & (1<<17))     a
 #else
 #define DEB(a)
 #define DEBUG(a)
@@ -2165,6 +2174,7 @@ Gid_t getegid (void);
 #define DEBUG_X(a)
 #define DEBUG_D(a)
 #define DEBUG_S(a)
+#define DEBUG_T(a)
 #endif
 #define YYMAXDEPTH 300
 
@@ -3045,46 +3055,53 @@ enum {
   to_sv_amg,   to_av_amg,
   to_hv_amg,   to_gv_amg,
   to_cv_amg,   iter_amg,    
-  max_amg_code
+  DESTROY_amg, max_amg_code
   /* Do not leave a trailing comma here.  C9X allows it, C89 doesn't. */
 };
 
 #define NofAMmeth max_amg_code
+#define AMG_id2name(id) ((char*)PL_AMG_names[id]+1)
 
 #ifdef DOINIT
 EXTCONST char * PL_AMG_names[NofAMmeth] = {
-  "fallback",  "abs",                  /* "fallback" should be the first. */
-  "bool",      "nomethod",
-  "\"\"",      "0+",
-  "+",         "+=",
-  "-",         "-=",
-  "*",         "*=",
-  "/",         "/=",
-  "%",         "%=",
-  "**",                "**=",
-  "<<",                "<<=",
-  ">>",                ">>=",
-  "&",         "&=",
-  "|",         "|=",
-  "^",         "^=",
-  "<",         "<=",
-  ">",         ">=",
-  "==",                "!=",
-  "<=>",       "cmp",
-  "lt",                "le",
-  "gt",                "ge",
-  "eq",                "ne",
-  "!",         "~",
-  "++",                "--",
-  "atan2",     "cos",
-  "sin",       "exp",
-  "log",       "sqrt",
-  "x",         "x=",
-  ".",         ".=",
-  "=",         "neg",
-  "${}",       "@{}",
-  "%{}",       "*{}",
-  "&{}",       "<>",
+  /* Names kept in the symbol table.  fallback => "()", the rest has
+     "(" prepended.  The only other place in perl which knows about
+     this convention is AMG_id2name (used for debugging output and
+     'nomethod' only), the only other place which has it hardwired is
+     overload.pm.  */
+  "()",                "(abs",                 /* "fallback" should be the first. */
+  "(bool",     "(nomethod",
+  "(\"\"",     "(0+",
+  "(+",                "(+=",
+  "(-",                "(-=",
+  "(*",                "(*=",
+  "(/",                "(/=",
+  "(%",                "(%=",
+  "(**",       "(**=",
+  "(<<",       "(<<=",
+  "(>>",       "(>>=",
+  "(&",                "(&=",
+  "(|",                "(|=",
+  "(^",                "(^=",
+  "(<",                "(<=",
+  "(>",                "(>=",
+  "(==",       "(!=",
+  "(<=>",      "(cmp",
+  "(lt",       "(le",
+  "(gt",       "(ge",
+  "(eq",       "(ne",
+  "(!",                "(~",
+  "(++",       "(--",
+  "(atan2",    "(cos",
+  "(sin",      "(exp",
+  "(log",      "(sqrt",
+  "(x",                "(x=",
+  "(.",                "(.=",
+  "(=",                "(neg",
+  "(${}",      "(@{}",
+  "(%{}",      "(*{}",
+  "(&{}",      "(<>",
+  "DESTROY",
 };
 #else
 EXTCONST char * PL_AMG_names[NofAMmeth];
@@ -3112,10 +3129,15 @@ typedef struct am_table_short AMTS;
 #define AMGfallYES     3
 
 #define AMTf_AMAGIC            1
+#define AMTf_OVERLOADED                2
 #define AMT_AMAGIC(amt)                ((amt)->flags & AMTf_AMAGIC)
 #define AMT_AMAGIC_on(amt)     ((amt)->flags |= AMTf_AMAGIC)
 #define AMT_AMAGIC_off(amt)    ((amt)->flags &= ~AMTf_AMAGIC)
+#define AMT_OVERLOADED(amt)    ((amt)->flags & AMTf_OVERLOADED)
+#define AMT_OVERLOADED_on(amt) ((amt)->flags |= AMTf_OVERLOADED)
+#define AMT_OVERLOADED_off(amt)        ((amt)->flags &= ~AMTf_OVERLOADED)
 
+#define StashHANDLER(stash,meth)       gv_handler((stash),CAT2(meth,_amg))
 
 /*
  * some compilers like to redefine cos et alia as faster
@@ -3436,6 +3458,10 @@ typedef struct am_table_short AMTS;
 #   include <libutil.h>                /* setproctitle() in some FreeBSDs */
 #endif
 
+#ifndef EXEC_ARGV_CAST
+#define EXEC_ARGV_CAST(x) x
+#endif
+
 /* and finally... */
 #define PERL_PATCHLEVEL_H_IMPLICIT
 #include "patchlevel.h"