X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Findirect.git;a=blobdiff_plain;f=indirect.xs;h=78788021af885ab2c1afaf3804c919fcd9e7f8f5;hp=0bfc3cd83679cabaa0d3390c7fa372090c36331f;hb=refs%2Ftags%2Frt83839;hpb=31786d861edccae57968f02e1872df9775ced1d4 diff --git a/indirect.xs b/indirect.xs index 0bfc3cd..7878802 100644 --- a/indirect.xs +++ b/indirect.xs @@ -35,8 +35,12 @@ # define SvPVX_const SvPVX #endif -#ifndef SvREFCNT_inc_simple_NN -# define SvREFCNT_inc_simple_NN SvREFCNT_inc +#ifndef SvREFCNT_inc_simple_void_NN +# ifdef SvREFCNT_inc_simple_NN +# define SvREFCNT_inc_simple_void_NN SvREFCNT_inc_simple_NN +# else +# define SvREFCNT_inc_simple_void_NN SvREFCNT_inc +# endif #endif #ifndef sv_catpvn_nomg @@ -71,6 +75,9 @@ # ifndef PL_oldbufptr # define PL_oldbufptr PL_parser->oldbufptr # endif +# ifndef PL_lex_inwhat +# define PL_lex_inwhat PL_parser->lex_inwhat +# endif #else # ifndef PL_linestr # define PL_linestr PL_Ilinestr @@ -81,6 +88,9 @@ # ifndef PL_oldbufptr # define PL_oldbufptr PL_Ioldbufptr # endif +# ifndef PL_lex_inwhat +# define PL_lex_inwhat PL_Ilex_inwhat +# endif #endif #ifndef I_WORKAROUND_REQUIRE_PROPAGATION @@ -128,6 +138,44 @@ # define MY_CXT_CLONE NOOP #endif +#if defined(OP_CHECK_MUTEX_LOCK) && defined(OP_CHECK_MUTEX_UNLOCK) +# define I_CHECK_MUTEX_LOCK OP_CHECK_MUTEX_LOCK +# define I_CHECK_MUTEX_UNLOCK OP_CHECK_MUTEX_UNLOCK +#else +# define I_CHECK_MUTEX_LOCK OP_REFCNT_LOCK +# define I_CHECK_MUTEX_UNLOCK OP_REFCNT_UNLOCK +#endif + +typedef OP *(*indirect_ck_t)(pTHX_ OP *); + +#ifdef wrap_op_checker + +# define indirect_ck_replace(T, NC, OCP) wrap_op_checker((T), (NC), (OCP)) + +#else + +STATIC void indirect_ck_replace(pTHX_ OPCODE type, indirect_ck_t new_ck, indirect_ck_t *old_ck_p) { +#define indirect_ck_replace(T, NC, OCP) indirect_ck_replace(aTHX_ (T), (NC), (OCP)) + I_CHECK_MUTEX_LOCK; + if (!*old_ck_p) { + *old_ck_p = PL_check[type]; + PL_check[type] = new_ck; + } + I_CHECK_MUTEX_UNLOCK; +} + +#endif + +STATIC void indirect_ck_restore(pTHX_ OPCODE type, indirect_ck_t *old_ck_p) { +#define indirect_ck_restore(T, OCP) indirect_ck_restore(aTHX_ (T), (OCP)) + I_CHECK_MUTEX_LOCK; + if (*old_ck_p) { + PL_check[type] = *old_ck_p; + *old_ck_p = 0; + } + I_CHECK_MUTEX_UNLOCK; +} + /* --- Helpers ------------------------------------------------------------- */ /* ... Thread-safe hints ................................................... */ @@ -182,10 +230,10 @@ typedef SV indirect_hint_t; * thread cleanup. */ typedef struct { + char *buf; STRLEN pos; STRLEN size; STRLEN len; - char *buf; line_t line; } indirect_op_info_t; @@ -212,6 +260,7 @@ typedef struct { tTHX owner; #endif ptable *map; + SV *global_code; } my_cxt_t; START_MY_CXT @@ -224,6 +273,9 @@ STATIC SV *indirect_clone(pTHX_ SV *sv, tTHX owner) { AV *stashes = NULL; SV *dupsv; + if (!sv) + return NULL; + if (SvTYPE(sv) == SVt_PVHV && HvNAME_get(sv)) stashes = newAV(); @@ -253,7 +305,6 @@ STATIC void indirect_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) { h2 = PerlMemShared_malloc(sizeof *h2); h2->code = indirect_clone(h1->code, ud->owner); - SvREFCNT_inc(h2->code); #if I_WORKAROUND_REQUIRE_PROPAGATION h2->require_tag = PTR2IV(indirect_clone(INT2PTR(SV *, h1->require_tag), ud->owner)); @@ -262,7 +313,6 @@ STATIC void indirect_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) { #else /* I_HINT_STRUCT */ h2 = indirect_clone(h1, ud->owner); - SvREFCNT_inc(h2); #endif /* !I_HINT_STRUCT */ @@ -274,6 +324,7 @@ STATIC void indirect_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) { STATIC void indirect_thread_cleanup(pTHX_ void *ud) { dMY_CXT; + SvREFCNT_dec(MY_CXT.global_code); ptable_free(MY_CXT.map); ptable_hints_free(MY_CXT.tbl); } @@ -335,7 +386,7 @@ STATIC SV *indirect_tag(pTHX_ SV *value) { value = SvRV(value); if (SvTYPE(value) >= SVt_PVCV) { code = value; - SvREFCNT_inc_simple_NN(code); + SvREFCNT_inc_simple_void_NN(code); } } @@ -365,21 +416,18 @@ STATIC SV *indirect_tag(pTHX_ SV *value) { STATIC SV *indirect_detag(pTHX_ const SV *hint) { #define indirect_detag(H) indirect_detag(aTHX_ (H)) indirect_hint_t *h; - - if (!(hint && SvIOK(hint))) - return NULL; +#if I_THREADSAFE || I_WORKAROUND_REQUIRE_PROPAGATION + dMY_CXT; +#endif h = INT2PTR(indirect_hint_t *, SvIVX(hint)); #if I_THREADSAFE - { - dMY_CXT; - h = ptable_fetch(MY_CXT.tbl, h); - } + h = ptable_fetch(MY_CXT.tbl, h); #endif /* I_THREADSAFE */ #if I_WORKAROUND_REQUIRE_PROPAGATION if (indirect_require_tag() != h->require_tag) - return NULL; + return MY_CXT.global_code; #endif /* I_WORKAROUND_REQUIRE_PROPAGATION */ return I_HINT_CODE(h); @@ -389,11 +437,16 @@ STATIC U32 indirect_hash = 0; STATIC SV *indirect_hint(pTHX) { #define indirect_hint() indirect_hint(aTHX) - SV *hint; + SV *hint = NULL; if (IN_PERL_RUNTIME) return NULL; +#if I_HAS_PERL(5, 10, 0) || defined(PL_parser) + if (!PL_parser) + return NULL; +#endif + #ifdef cop_hints_fetch_pvn hint = cop_hints_fetch_pvn(PL_curcop, __PACKAGE__, __PACKAGE_LEN__, indirect_hash, 0); @@ -405,15 +458,18 @@ STATIC SV *indirect_hint(pTHX) { indirect_hash); #else { - SV **val = hv_fetch(GvHV(PL_hintgv), __PACKAGE__, __PACKAGE_LEN__, - indirect_hash); - if (!val) - return 0; - hint = *val; + SV **val = hv_fetch(GvHV(PL_hintgv), __PACKAGE__, __PACKAGE_LEN__, 0); + if (val) + hint = *val; } #endif - return indirect_detag(hint); + if (hint && SvIOK(hint)) + return indirect_detag(hint); + else { + dMY_CXT; + return MY_CXT.global_code; + } } /* ... op -> source position ............................................... */ @@ -467,33 +523,41 @@ STATIC void indirect_map_delete(pTHX_ const OP *o) { /* --- Check functions ----------------------------------------------------- */ -STATIC int indirect_find(pTHX_ SV *sv, const char *s, STRLEN *pos) { -#define indirect_find(N, S, P) indirect_find(aTHX_ (N), (S), (P)) - STRLEN len; - const char *p, *r = SvPV_const(sv, len); - - if (len >= 1 && *r == '$') { - ++r; - --len; - s = strchr(s, '$'); - if (!s) +STATIC int indirect_find(pTHX_ SV *name_sv, const char *line_bufptr, STRLEN *name_pos) { +#define indirect_find(NSV, LBP, NP) indirect_find(aTHX_ (NSV), (LBP), (NP)) + STRLEN name_len, line_len; + const char *name, *name_end; + const char *line, *line_end; + const char *p; + + line = SvPV_const(PL_linestr, line_len); + line_end = line + line_len; + + name = SvPV_const(name_sv, name_len); + if (name_len >= 1 && *name == '$') { + ++name; + --name_len; + while (line_bufptr < line_end && *line_bufptr != '$') + ++line_bufptr; + if (line_bufptr >= line_end) return 0; } + name_end = name + name_len; - p = s; + p = line_bufptr; while (1) { - p = strstr(p, r); + p = ninstr(p, line_end, name, name_end); if (!p) return 0; - if (!isALNUM(p[len])) + if (!isALNUM(p[name_len])) break; - /* p points to a word that has r as prefix, skip the rest of the word */ - p += len + 1; + /* p points to a word that has name as prefix, skip the rest of the word */ + p += name_len + 1; while (isALNUM(*p)) ++p; } - *pos = p - SvPVX_const(PL_linestr); + *name_pos = p - line; return 1; } @@ -772,7 +836,8 @@ STATIC OP *indirect_ck_entersub(pTHX_ OP *o) { /* When positions are identical, the method and the object must have the * same name. But it also means that it is an indirect call, as "foo->foo" * results in different positions. */ - if (moi->pos <= ooi->pos) { + if ( moi->line < ooi->line + || (moi->line == ooi->line && moi->pos <= ooi->pos)) { SV *file; dSP; @@ -825,23 +890,15 @@ STATIC void indirect_teardown(pTHX_ void *root) { #endif } - PL_check[OP_CONST] = MEMBER_TO_FPTR(indirect_old_ck_const); - indirect_old_ck_const = 0; - PL_check[OP_RV2SV] = MEMBER_TO_FPTR(indirect_old_ck_rv2sv); - indirect_old_ck_rv2sv = 0; - PL_check[OP_PADANY] = MEMBER_TO_FPTR(indirect_old_ck_padany); - indirect_old_ck_padany = 0; - PL_check[OP_SCOPE] = MEMBER_TO_FPTR(indirect_old_ck_scope); - indirect_old_ck_scope = 0; - PL_check[OP_LINESEQ] = MEMBER_TO_FPTR(indirect_old_ck_lineseq); - indirect_old_ck_lineseq = 0; - - PL_check[OP_METHOD] = MEMBER_TO_FPTR(indirect_old_ck_method); - indirect_old_ck_method = 0; - PL_check[OP_METHOD_NAMED] = MEMBER_TO_FPTR(indirect_old_ck_method_named); - indirect_old_ck_method_named = 0; - PL_check[OP_ENTERSUB] = MEMBER_TO_FPTR(indirect_old_ck_entersub); - indirect_old_ck_entersub = 0; + indirect_ck_restore(OP_CONST, &indirect_old_ck_const); + indirect_ck_restore(OP_RV2SV, &indirect_old_ck_rv2sv); + indirect_ck_restore(OP_PADANY, &indirect_old_ck_padany); + indirect_ck_restore(OP_SCOPE, &indirect_old_ck_scope); + indirect_ck_restore(OP_LINESEQ, &indirect_old_ck_lineseq); + + indirect_ck_restore(OP_METHOD, &indirect_old_ck_method); + indirect_ck_restore(OP_METHOD_NAMED, &indirect_old_ck_method_named); + indirect_ck_restore(OP_ENTERSUB, &indirect_old_ck_entersub); indirect_initialized = 0; } @@ -854,29 +911,25 @@ STATIC void indirect_setup(pTHX) { { MY_CXT_INIT; #if I_THREADSAFE - MY_CXT.tbl = ptable_new(); - MY_CXT.owner = aTHX; + MY_CXT.tbl = ptable_new(); + MY_CXT.owner = aTHX; #endif - MY_CXT.map = ptable_new(); + MY_CXT.map = ptable_new(); + MY_CXT.global_code = NULL; } - indirect_old_ck_const = PL_check[OP_CONST]; - PL_check[OP_CONST] = MEMBER_TO_FPTR(indirect_ck_const); - indirect_old_ck_rv2sv = PL_check[OP_RV2SV]; - PL_check[OP_RV2SV] = MEMBER_TO_FPTR(indirect_ck_rv2sv); - indirect_old_ck_padany = PL_check[OP_PADANY]; - PL_check[OP_PADANY] = MEMBER_TO_FPTR(indirect_ck_padany); - indirect_old_ck_scope = PL_check[OP_SCOPE]; - PL_check[OP_SCOPE] = MEMBER_TO_FPTR(indirect_ck_scope); - indirect_old_ck_lineseq = PL_check[OP_LINESEQ]; - PL_check[OP_LINESEQ] = MEMBER_TO_FPTR(indirect_ck_scope); - - indirect_old_ck_method = PL_check[OP_METHOD]; - PL_check[OP_METHOD] = MEMBER_TO_FPTR(indirect_ck_method); - indirect_old_ck_method_named = PL_check[OP_METHOD_NAMED]; - PL_check[OP_METHOD_NAMED] = MEMBER_TO_FPTR(indirect_ck_method_named); - indirect_old_ck_entersub = PL_check[OP_ENTERSUB]; - PL_check[OP_ENTERSUB] = MEMBER_TO_FPTR(indirect_ck_entersub); + indirect_ck_replace(OP_CONST, indirect_ck_const, &indirect_old_ck_const); + indirect_ck_replace(OP_RV2SV, indirect_ck_rv2sv, &indirect_old_ck_rv2sv); + indirect_ck_replace(OP_PADANY, indirect_ck_padany, &indirect_old_ck_padany); + indirect_ck_replace(OP_SCOPE, indirect_ck_scope, &indirect_old_ck_scope); + indirect_ck_replace(OP_LINESEQ, indirect_ck_scope, &indirect_old_ck_lineseq); + + indirect_ck_replace(OP_METHOD, indirect_ck_method, + &indirect_old_ck_method); + indirect_ck_replace(OP_METHOD_NAMED, indirect_ck_method_named, + &indirect_old_ck_method_named); + indirect_ck_replace(OP_ENTERSUB, indirect_ck_entersub, + &indirect_old_ck_entersub); #if I_MULTIPLICITY call_atexit(indirect_teardown, aTHX); @@ -917,6 +970,7 @@ CLONE(...) PROTOTYPE: DISABLE PREINIT: ptable *t; + SV *global_code_dup; PPCODE: { my_cxt_t ud; @@ -924,12 +978,14 @@ PPCODE: ud.tbl = t = ptable_new(); ud.owner = MY_CXT.owner; ptable_walk(MY_CXT.tbl, indirect_ptable_clone, &ud); + global_code_dup = indirect_clone(MY_CXT.global_code, MY_CXT.owner); } { MY_CXT_CLONE; - MY_CXT.map = ptable_new(); - MY_CXT.tbl = t; - MY_CXT.owner = aTHX; + MY_CXT.map = ptable_new(); + MY_CXT.tbl = t; + MY_CXT.owner = aTHX; + MY_CXT.global_code = global_code_dup; } reap(3, indirect_thread_cleanup, NULL); XSRETURN(0); @@ -943,3 +999,18 @@ CODE: RETVAL = indirect_tag(value); OUTPUT: RETVAL + +void +_global(SV *code) +PROTOTYPE: $ +PPCODE: + if (!SvOK(code)) + code = NULL; + else if (SvROK(code)) + code = SvRV(code); + { + dMY_CXT; + SvREFCNT_dec(MY_CXT.global_code); + MY_CXT.global_code = SvREFCNT_inc(code); + } + XSRETURN(0);