From: Nick Ing-Simmons Date: Tue, 15 Jan 2002 11:29:47 +0000 (+0000) Subject: Regen embed enable slab for PERL_IMPLICIT_SYS X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ba979b3106a5e7f3b2512d1f4e93c681fba7aa9f;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- a/perl.h +++ b/perl.h @@ -41,6 +41,15 @@ /* See L 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 --- 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 --- 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 ); +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 --- 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