Slab allocator for ops

 - moved the statics to intrpvar.h
 - implemented Slab_Free()
 - uses PerlMemShared (for now) if distinction exists.

p4raw-id: //depot/perlio@14250

diff --git a/embed.fnc b/embed.fnc
index 729f914..f5fcac6 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1007,6 +1007,7 @@ s |void   |apply_attrs    |HV *stash|SV *target|OP *attrs|bool for_my
 s      |void   |apply_attrs_my |HV *stash|OP *target|OP *attrs|OP **imopsp
 #  if defined(PL_OP_SLAB_ALLOC)
 s      |void*  |Slab_Alloc     |int m|size_t sz
+s      |void   |Slab_Free      |void *
 #  endif
 #endif
 

diff --git a/embed.h b/embed.h
index 6203634..cbd880e 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -936,6 +936,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)
@@ -2477,6 +2478,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/intrpvar.h b/intrpvar.h
index 3d08143..4486d2f 100644 (file)
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -512,6 +512,12 @@ PERLVAR(Idebug_pad,        struct perl_debug_pad)  /* always needed because of the re ex
 
 PERLVAR(Itaint_warn, bool)      /* taint warns instead of dying */
 
+#ifdef PL_OP_SLAB_ALLOC
+PERLVAR(IOpPtr,IV **)
+PERLVARI(IOpSpace,int,0)
+PERLVAR(IOpSlab,IV *)
+#endif
+
 /* New variables must be added to the very end for binary compatibility.
  * XSUB.h provides wrapper functions via perlapi.h that make this
  * irrelevant, but not all code may be expected to #include XSUB.h. */

diff --git a/op.c b/op.c
index c97dacd..2230aaf 100644 (file)
--- a/op.c
+++ b/op.c
@@ -23,28 +23,66 @@
 
 #define CALL_PEEP(o) CALL_FPTR(PL_peepp)(aTHX_ o)
 
-/* #define PL_OP_SLAB_ALLOC */
-
-#if defined(PL_OP_SLAB_ALLOC) && !defined(PERL_IMPLICIT_CONTEXT)
-#define SLAB_SIZE 8192
-static char    *PL_OpPtr  = NULL;      /* XXX threadead */
-static int     PL_OpSpace = 0;         /* XXX threadead */
-#define NewOp(m,var,c,type) do { if ((PL_OpSpace -= c*sizeof(type)) >= 0)     \
-                              var =  (type *)(PL_OpPtr -= c*sizeof(type));    \
-                             else                                             \
-                              var = (type *) Slab_Alloc(m,c*sizeof(type));    \
-                           } while (0)
+#if defined(PL_OP_SLAB_ALLOC)
+
+#ifndef PERL_SLAB_SIZE
+#define PERL_SLAB_SIZE 2048
+#endif
+
+#define NewOp(m,var,c,type) \
+       STMT_START { var = (type *) Slab_Alloc(m,c*sizeof(type)); } STMT_END
+
+#define FreeOp(p) Slab_Free(p)
 
 STATIC void *
 S_Slab_Alloc(pTHX_ int m, size_t sz)
 {
- Newz(m,PL_OpPtr,SLAB_SIZE,char);
- PL_OpSpace = SLAB_SIZE - sz;
- return PL_OpPtr += PL_OpSpace;
+    /* Add an overhead for pointer to slab and round up as a number of IVs */
+    sz = (sz + 2*sizeof(IV) -1)/sizeof(IV);
+    if ((PL_OpSpace -= sz) < 0) {
+       PL_OpSlab = (IV *) PerlMemShared_malloc(PERL_SLAB_SIZE*sizeof(IV));
+       if (!PL_OpSlab) {
+           return NULL;
+       }
+       Zero(PL_OpSlab,PERL_SLAB_SIZE,IV);
+       /* We reserve the 0'th word as a use count */
+       PL_OpSpace = PERL_SLAB_SIZE - 1 - sz;
+       /* Allocation pointer starts at the top.
+          Theory: because we build leaves before trunk allocating at end
+          means that at run time access is cache friendly upward
+        */
+       PL_OpPtr   = (IV **) &PL_OpSlab[PERL_SLAB_SIZE];
+    }
+    assert( PL_OpSpace >= 0 );
+    /* Move the allocation pointer down */
+    PL_OpPtr   -= sz;
+    assert( PL_OpPtr > (IV **) PL_OpSlab );
+    *PL_OpPtr   = PL_OpSlab;   /* Note which slab it belongs to */
+    (*PL_OpSlab)++;            /* Increment use count of slab */
+    assert( (IV *) (PL_OpPtr+sz) <= (PL_OpSlab + PERL_SLAB_SIZE) );
+    assert( *PL_OpSlab > 0 );
+    return (void *)(PL_OpPtr + 1);
+}
+
+STATIC void
+S_Slab_Free(pTHX_ void *op)
+{
+    IV **ptr = (IV **) op;
+    IV *slab = ptr[-1];
+    assert( ptr-1 > (IV **) slab );
+    assert( (IV *) ptr < (slab + PERL_SLAB_SIZE) );
+    assert( *slab > 0 );
+    if (--(*slab) == 0) {
+       PerlMemShared_free(slab);
+       if (slab == PL_OpSlab) {
+           PL_OpSpace = 0;
+       }
+    }
 }
 
 #else
 #define NewOp(m, var, c, type) Newz(m, var, c, type)
+#define FreeOp(p) SafeFree(p)
 #endif
 /*
  * In the following definition, the ", Nullop" is just to make the compiler
@@ -735,14 +773,7 @@ Perl_op_free(pTHX_ OP *o)
        cop_free((COP*)o);
 
     op_clear(o);
-
-#ifdef PL_OP_SLAB_ALLOC
-    if ((char *) o == PL_OpPtr)
-     {
-     }
-#else
-    Safefree(o);
-#endif
+    FreeOp(o);
 }
 
 void
@@ -2583,10 +2614,8 @@ Perl_append_list(pTHX_ I32 type, LISTOP *first, LISTOP *last)
     first->op_last = last->op_last;
     first->op_flags |= (last->op_flags & OPf_KIDS);
 
-#ifdef PL_OP_SLAB_ALLOC
-#else
-    Safefree(last);
-#endif
+    FreeOp(last);
+
     return (OP*)first;
 }
 
@@ -4288,6 +4317,7 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo
        LOOP *tmp;
        NewOp(1234,tmp,1,LOOP);
        Copy(loop,tmp,1,LOOP);
+       FreeOp(loop);
        loop = tmp;
     }
 #else

diff --git a/perl.h b/perl.h
index 3dcb146..4a14d84 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -9,6 +9,8 @@
 #ifndef H_PERL
 #define H_PERL 1
 
+#define PL_OP_SLAB_ALLOC
+
 #ifdef PERL_FOR_X2P
 /*
  * This file is being used for x2p stuff.

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 ea837ec..0bdb25c 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1043,6 +1043,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