Regen embed enable slab for PERL_IMPLICIT_SYS

p4raw-id: //depot/perlio@14271

diff --git a/embed.h b/embed.h
index b6ee614..bbae4f1 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -938,6 +938,7 @@
 #define apply_attrs_my         S_apply_attrs_my
 #  if defined(PL_OP_SLAB_ALLOC)
 #define Slab_Alloc             S_Slab_Alloc
+#define Slab_Free              S_Slab_Free
 #  endif
 #endif
 #if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT)
@@ -2481,6 +2482,7 @@
 #define apply_attrs_my(a,b,c,d)        S_apply_attrs_my(aTHX_ a,b,c,d)
 #  if defined(PL_OP_SLAB_ALLOC)
 #define Slab_Alloc(a,b)                S_Slab_Alloc(aTHX_ a,b)
+#define Slab_Free(a)           S_Slab_Free(aTHX_ a)
 #  endif
 #endif
 #if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT)

diff --git a/embedvar.h b/embedvar.h
index 16c8e46..c6eb5fa 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -183,6 +183,9 @@
 #define PL_Mem                 (PERL_GET_INTERP->IMem)
 #define PL_MemParse            (PERL_GET_INTERP->IMemParse)
 #define PL_MemShared           (PERL_GET_INTERP->IMemShared)
+#define PL_OpPtr               (PERL_GET_INTERP->IOpPtr)
+#define PL_OpSlab              (PERL_GET_INTERP->IOpSlab)
+#define PL_OpSpace             (PERL_GET_INTERP->IOpSpace)
 #define PL_Proc                        (PERL_GET_INTERP->IProc)
 #define PL_Sock                        (PERL_GET_INTERP->ISock)
 #define PL_StdIO               (PERL_GET_INTERP->IStdIO)
@@ -478,6 +481,9 @@
 #define PL_Mem                 (vTHX->IMem)
 #define PL_MemParse            (vTHX->IMemParse)
 #define PL_MemShared           (vTHX->IMemShared)
+#define PL_OpPtr               (vTHX->IOpPtr)
+#define PL_OpSlab              (vTHX->IOpSlab)
+#define PL_OpSpace             (vTHX->IOpSpace)
 #define PL_Proc                        (vTHX->IProc)
 #define PL_Sock                        (vTHX->ISock)
 #define PL_StdIO               (vTHX->IStdIO)
@@ -776,6 +782,9 @@
 #define PL_IMem                        PL_Mem
 #define PL_IMemParse           PL_MemParse
 #define PL_IMemShared          PL_MemShared
+#define PL_IOpPtr              PL_OpPtr
+#define PL_IOpSlab             PL_OpSlab
+#define PL_IOpSpace            PL_OpSpace
 #define PL_IProc               PL_Proc
 #define PL_ISock               PL_Sock
 #define PL_IStdIO              PL_StdIO

diff --git a/perl.h b/perl.h
index 3dcb146..651f15c 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -41,6 +41,15 @@
 /* See L<perlguts/"The Perl API"> for detailed notes on
  * PERL_IMPLICIT_CONTEXT and PERL_IMPLICIT_SYS */
 
+#ifdef PERL_IMPLICIT_SYS
+/* PERL_IMPLICIT_SYS implies PerlMemShared != PerlMem
+   so use slab allocator to avoid lots of MUTEX overhead
+ */
+#  ifndef PL_SLAB_ALLOC
+#    define PL_SLAB_ALLOC
+#  endif
+#endif
+
 #ifdef USE_ITHREADS
 #  if !defined(MULTIPLICITY)
 #    define MULTIPLICITY

diff --git a/perlapi.h b/perlapi.h
index 3d74ecd..76eb92f 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -103,6 +103,12 @@ END_EXTERN_C
 #define PL_MemParse            (*Perl_IMemParse_ptr(aTHX))
 #undef  PL_MemShared
 #define PL_MemShared           (*Perl_IMemShared_ptr(aTHX))
+#undef  PL_OpPtr
+#define PL_OpPtr               (*Perl_IOpPtr_ptr(aTHX))
+#undef  PL_OpSlab
+#define PL_OpSlab              (*Perl_IOpSlab_ptr(aTHX))
+#undef  PL_OpSpace
+#define PL_OpSpace             (*Perl_IOpSpace_ptr(aTHX))
 #undef  PL_Proc
 #define PL_Proc                        (*Perl_IProc_ptr(aTHX))
 #undef  PL_Sock

diff --git a/proto.h b/proto.h
index 7c49f3f..9c79381 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1045,6 +1045,7 @@ STATIC void       S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my);
 STATIC void    S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp);
 #  if defined(PL_OP_SLAB_ALLOC)
 STATIC void*   S_Slab_Alloc(pTHX_ int m, size_t sz);
+STATIC void    S_Slab_Free(pTHX_ void *);
 #  endif
 #endif
 
@@ -1106,7 +1107,7 @@ STATIC I32        S_dopoptoeval(pTHX_ I32 startingblock);
 STATIC I32     S_dopoptolabel(pTHX_ char *label);
 STATIC I32     S_dopoptoloop(pTHX_ I32 startingblock);
 STATIC I32     S_dopoptosub(pTHX_ I32 startingblock);
-STATIC I32     S_dopoptosub_at(pTHX_ PERL_CONTEXT* cxstk, I32 startingblock\r);
+STATIC I32     S_dopoptosub_at(pTHX_ PERL_CONTEXT* cxstk, I32 startingblock);
 STATIC void    S_save_lines(pTHX_ AV *array, SV *sv);
 STATIC OP*     S_doeval(pTHX_ int gimme, OP** startop);
 STATIC PerlIO *        S_doopen_pmc(pTHX_ const char *name, const char *mode);

diff --git a/toke.c b/toke.c
index 901ebd9..6528ef4 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -2180,7 +2180,7 @@ Perl_yylex(pTHX)
     bool bof = FALSE;
 
     /* check if there's an identifier for us to look at */
-    if (PL_pending_ident) 
+    if (PL_pending_ident)
         return S_pending_ident(aTHX);
 
     /* no identifier pending identification */
@@ -6668,12 +6668,12 @@ S_scan_inputsymbol(pTHX_ char *start)
            (void)strcpy(d,"ARGV");
 
        /* Check whether readline() is overriden */
-       if ((gv_readline = gv_fetchpv("readline", FALSE, SVt_PVCV))
-               && GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline)
+       if (((gv_readline = gv_fetchpv("readline", FALSE, SVt_PVCV))
+               && GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline))
                ||
-               (gvp = (GV**)hv_fetch(PL_globalstash, "readline", 8, FALSE))
+               ((gvp = (GV**)hv_fetch(PL_globalstash, "readline", 8, FALSE))
                && (gv_readline = *gvp) != (GV*)&PL_sv_undef
-               && GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline))
+               && GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline)))
            readline_overriden = TRUE;
 
        /* if <$fh>, create the ops to turn the variable into a