summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--embed.fnc1
-rw-r--r--embed.h2
-rw-r--r--embedvar.h9
-rw-r--r--intrpvar.h6
-rw-r--r--op.c82
-rw-r--r--perl.h2
-rw-r--r--perlapi.h6
-rw-r--r--proto.h1
8 files changed, 26 insertions, 83 deletions
diff --git a/embed.fnc b/embed.fnc
index f5fcac6cd4..729f9141c1 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1007,7 +1007,6 @@ 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 cbd880ed45..6203634e92 100644
--- a/embed.h
+++ b/embed.h
@@ -936,7 +936,6 @@
#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)
@@ -2478,7 +2477,6 @@
#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 c6eb5fa7ae..16c8e46233 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -183,9 +183,6 @@
#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)
@@ -481,9 +478,6 @@
#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)
@@ -782,9 +776,6 @@
#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 4486d2f636..3d08143fb6 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -512,12 +512,6 @@ 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 2230aaf243..c97dacd5c3 100644
--- a/op.c
+++ b/op.c
@@ -23,66 +23,28 @@
#define CALL_PEEP(o) CALL_FPTR(PL_peepp)(aTHX_ o)
-#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)
+/* #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)
STATIC void *
S_Slab_Alloc(pTHX_ int m, size_t sz)
{
- /* 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;
- }
- }
+ Newz(m,PL_OpPtr,SLAB_SIZE,char);
+ PL_OpSpace = SLAB_SIZE - sz;
+ return PL_OpPtr += PL_OpSpace;
}
#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
@@ -773,7 +735,14 @@ Perl_op_free(pTHX_ OP *o)
cop_free((COP*)o);
op_clear(o);
- FreeOp(o);
+
+#ifdef PL_OP_SLAB_ALLOC
+ if ((char *) o == PL_OpPtr)
+ {
+ }
+#else
+ Safefree(o);
+#endif
}
void
@@ -2614,8 +2583,10 @@ Perl_append_list(pTHX_ I32 type, LISTOP *first, LISTOP *last)
first->op_last = last->op_last;
first->op_flags |= (last->op_flags & OPf_KIDS);
- FreeOp(last);
-
+#ifdef PL_OP_SLAB_ALLOC
+#else
+ Safefree(last);
+#endif
return (OP*)first;
}
@@ -4317,7 +4288,6 @@ 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 a7a78498da..7a876b59c4 100644
--- a/perl.h
+++ b/perl.h
@@ -9,8 +9,6 @@
#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 76eb92f2c5..3d74ecd281 100644
--- a/perlapi.h
+++ b/perlapi.h
@@ -103,12 +103,6 @@ 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 0bdb25cd74..ea837ec209 100644
--- a/proto.h
+++ b/proto.h
@@ -1043,7 +1043,6 @@ 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
View Lorry Controller Status