diff options
| -rw-r--r-- | embed.fnc | 1 | ||||
| -rw-r--r-- | embed.h | 2 | ||||
| -rw-r--r-- | embedvar.h | 9 | ||||
| -rw-r--r-- | intrpvar.h | 6 | ||||
| -rw-r--r-- | op.c | 82 | ||||
| -rw-r--r-- | perl.h | 2 | ||||
| -rw-r--r-- | perlapi.h | 6 | ||||
| -rw-r--r-- | proto.h | 1 |
8 files changed, 83 insertions, 26 deletions
@@ -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 @@ -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 16c8e46233..c6eb5fa7ae 100644 --- 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 3d08143fb6..4486d2f636 100644 --- 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. */ @@ -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 @@ -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. @@ -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 @@ -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 |