X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Findirect.git;a=blobdiff_plain;f=indirect.xs;h=8e6c789b1b0098315650bf8b05193aac0eb0c77e;hp=02a13f8059dcab4bad9e56dbc3ef7c8b8783780a;hb=4cb0e2cc26fbe39a7a040b090b1a1e6c2380af0f;hpb=ee6e199ac0d363cb7d67d6ea0fc695416552d959 diff --git a/indirect.xs b/indirect.xs index 02a13f8..8e6c789 100644 --- a/indirect.xs +++ b/indirect.xs @@ -19,6 +19,10 @@ # define dNOOP #endif +#ifndef Newx +# define Newx(v, n, c) New(0, v, n, c) +#endif + #ifndef SvPV_const # define SvPV_const SvPV #endif @@ -31,10 +35,18 @@ # define SvPVX_const SvPVX #endif +#ifndef SvREFCNT_inc_simple_NN +# define SvREFCNT_inc_simple_NN SvREFCNT_inc +#endif + #ifndef sv_catpvn_nomg # define sv_catpvn_nomg sv_catpvn #endif +#ifndef mPUSHp +# define mPUSHp(P, L) PUSHs(sv_2mortal(newSVpvn((P), (L)))) +#endif + #ifndef mPUSHu # define mPUSHu(U) PUSHs(sv_2mortal(newSVuv(U))) #endif @@ -152,8 +164,15 @@ typedef struct { /* Define the op->str ptable here because we need to be able to clean it during * thread cleanup. */ +typedef struct { + const char *pos; + char *buf; + STRLEN len, size; + line_t line; +} indirect_op_info_t; + #define PTABLE_NAME ptable -#define PTABLE_VAL_FREE(V) SvREFCNT_dec(V) +#define PTABLE_VAL_FREE(V) if (V) { Safefree(((indirect_op_info_t *) (V))->buf); Safefree(V); } #define pPTBL pTHX #define pPTBL_ pTHX_ @@ -245,12 +264,21 @@ STATIC void indirect_thread_cleanup(pTHX_ void *ud) { STATIC SV *indirect_tag(pTHX_ SV *value) { #define indirect_tag(V) indirect_tag(aTHX_ (V)) indirect_hint_t *h; + SV *code = NULL; dMY_CXT; - value = SvOK(value) && SvROK(value) ? SvRV(value) : NULL; + if (SvOK(value) && SvROK(value)) { + value = SvRV(value); + if (SvTYPE(value) >= SVt_PVCV) { + code = value; + if (CvANON(code) && !CvCLONED(code)) + CvCLONE_on(code); + SvREFCNT_inc_simple_NN(code); + } + } h = PerlMemShared_malloc(sizeof *h); - h->code = SvREFCNT_inc(value); + h->code = code; #if I_WORKAROUND_REQUIRE_PROPAGATION { @@ -336,6 +364,10 @@ STATIC U32 indirect_hash = 0; STATIC SV *indirect_hint(pTHX) { #define indirect_hint() indirect_hint(aTHX) SV *hint; + + if (IN_PERL_RUNTIME) + return NULL; + #if I_HAS_PERL(5, 9, 5) hint = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash, NULL, @@ -343,21 +375,25 @@ STATIC SV *indirect_hint(pTHX) { 0, indirect_hash); #else - SV **val = hv_fetch(GvHV(PL_hintgv), __PACKAGE__, __PACKAGE_LEN__, + { + SV **val = hv_fetch(GvHV(PL_hintgv), __PACKAGE__, __PACKAGE_LEN__, indirect_hash); - if (!val) - return 0; - hint = *val; + if (!val) + return 0; + hint = *val; + } #endif return indirect_detag(hint); } /* ... op -> source position ............................................... */ -STATIC void indirect_map_store(pTHX_ const OP *o, const char *src, SV *sv) { -#define indirect_map_store(O, S, N) indirect_map_store(aTHX_ (O), (S), (N)) +STATIC void indirect_map_store(pTHX_ const OP *o, const char *src, SV *sv, line_t line) { +#define indirect_map_store(O, S, N, L) indirect_map_store(aTHX_ (O), (S), (N), (L)) + indirect_op_info_t *oi; + const char *s; + STRLEN len; dMY_CXT; - SV *val; /* When lex_inwhat is set, we're in a quotelike environment (qq, qr, but not q) * In this case the linestr has temporarly changed, but the old buffer should @@ -371,32 +407,41 @@ STATIC void indirect_map_store(pTHX_ const OP *o, const char *src, SV *sv) { } } - val = newSVsv(sv); - SvUPGRADE(val, SVt_PVIV); - SvUVX(val) = PTR2UV(src); - SvIOK_on(val); - SvIsUV_on(val); - SvREADONLY_on(val); + if (!(oi = ptable_fetch(MY_CXT.map, o))) { + Newx(oi, 1, indirect_op_info_t); + ptable_store(MY_CXT.map, o, oi); + oi->buf = NULL; + oi->size = 0; + } - ptable_store(MY_CXT.map, o, val); + if (sv) { + s = SvPV_const(sv, len); + } else { + s = "{"; + len = 1; + } + + if (len > oi->size) { + Safefree(oi->buf); + Newx(oi->buf, len, char); + oi->size = len; + } + Copy(s, oi->buf, len, char); + + oi->len = len; + oi->pos = src; + oi->line = line; } -STATIC const char *indirect_map_fetch(pTHX_ const OP *o, SV ** const name) { -#define indirect_map_fetch(O, S) indirect_map_fetch(aTHX_ (O), (S)) +STATIC const indirect_op_info_t *indirect_map_fetch(pTHX_ const OP *o) { +#define indirect_map_fetch(O) indirect_map_fetch(aTHX_ (O)) + const indirect_op_info_t *val; dMY_CXT; - SV *val; if (MY_CXT.linestr != SvPVX_const(PL_linestr)) return NULL; - val = ptable_fetch(MY_CXT.map, o); - if (!val) { - *name = NULL; - return NULL; - } - - *name = val; - return INT2PTR(const char *, SvUVX(val)); + return ptable_fetch(MY_CXT.map, o); } STATIC void indirect_map_delete(pTHX_ const OP *o) { @@ -442,7 +487,8 @@ STATIC OP *indirect_ck_const(pTHX_ OP *o) { if (indirect_hint()) { SV *sv = cSVOPo_sv; if (SvPOK(sv) && (SvTYPE(sv) >= SVt_PV)) { - indirect_map_store(o, indirect_find(sv, PL_oldbufptr), sv); + const char *s = indirect_find(sv, PL_oldbufptr); + indirect_map_store(o, s, sv, CopLINE(&PL_compiling)); return o; } } @@ -507,7 +553,7 @@ STATIC OP *indirect_ck_rv2sv(pTHX_ OP *o) { } o = CALL_FPTR(indirect_old_ck_rv2sv)(aTHX_ o); - indirect_map_store(o, s, sv); + indirect_map_store(o, s, sv, CopLINE(&PL_compiling)); return o; } @@ -535,7 +581,7 @@ STATIC OP *indirect_ck_padany(pTHX_ OP *o) { while (s < t && isSPACE(*t)) --t; sv = sv_2mortal(newSVpvn("$", 1)); sv_catpvn_nomg(sv, s, t - s + 1); - indirect_map_store(o, s, sv); + indirect_map_store(o, s, sv, CopLINE(&PL_compiling)); return o; } } @@ -544,6 +590,32 @@ STATIC OP *indirect_ck_padany(pTHX_ OP *o) { return o; } +/* ... ck_scope ............................................................ */ + +STATIC OP *(*indirect_old_ck_scope) (pTHX_ OP *) = 0; +STATIC OP *(*indirect_old_ck_lineseq)(pTHX_ OP *) = 0; + +STATIC OP *indirect_ck_scope(pTHX_ OP *o) { + OP *(*old_ck)(pTHX_ OP *) = 0; + + switch (o->op_type) { + case OP_SCOPE: old_ck = indirect_old_ck_scope; break; + case OP_LINESEQ: old_ck = indirect_old_ck_lineseq; break; + } + o = CALL_FPTR(old_ck)(aTHX_ o); + + if (indirect_hint()) { + indirect_map_store(o, PL_oldbufptr, NULL, CopLINE(&PL_compiling)); + return o; + } + + indirect_map_delete(o); + return o; +} + +/* We don't need to clean the map entries for leave ops because they can only + * be created by mutating from a lineseq. */ + /* ... ck_method ........................................................... */ STATIC OP *(*indirect_old_ck_method)(pTHX_ OP *) = 0; @@ -551,18 +623,27 @@ STATIC OP *(*indirect_old_ck_method)(pTHX_ OP *) = 0; STATIC OP *indirect_ck_method(pTHX_ OP *o) { if (indirect_hint()) { OP *op = cUNOPo->op_first; + const indirect_op_info_t *oi = indirect_map_fetch(op); + const char *s = NULL; + line_t line; SV *sv; - const char *s = indirect_map_fetch(op, &sv); - if (!s) { + + if (oi && (s = oi->pos)) { + sv = sv_2mortal(newSVpvn(oi->buf, oi->len)); + line = oi->line; /* Keep the old line so that we really point to the first */ + } else { sv = cSVOPx_sv(op); if (!SvPOK(sv) || (SvTYPE(sv) < SVt_PV)) goto done; - sv = sv_mortalcopy(sv); - s = indirect_find(sv, PL_oldbufptr); + sv = sv_mortalcopy(sv); + s = indirect_find(sv, PL_oldbufptr); + line = CopLINE(&PL_compiling); } + o = CALL_FPTR(indirect_old_ck_method)(aTHX_ o); /* o may now be a method_named */ - indirect_map_store(o, s, sv); + + indirect_map_store(o, s, sv, line); return o; } @@ -575,6 +656,16 @@ done: /* ... ck_entersub ......................................................... */ +STATIC int indirect_is_indirect(const indirect_op_info_t *moi, const indirect_op_info_t *ooi) { + if (moi->pos > ooi->pos) + return 0; + + if (moi->pos == ooi->pos) + return moi->len == ooi->len && !memcmp(moi->buf, ooi->buf, moi->len); + + return 1; +} + STATIC OP *(*indirect_old_ck_entersub)(pTHX_ OP *) = 0; STATIC OP *indirect_ck_entersub(pTHX_ OP *o) { @@ -583,9 +674,8 @@ STATIC OP *indirect_ck_entersub(pTHX_ OP *o) { o = CALL_FPTR(indirect_old_ck_entersub)(aTHX_ o); if (code) { - const char *mpos, *opos; - SV *mnamesv, *onamesv; - OP *mop, *oop; + const indirect_op_info_t *moi, *ooi; + OP *mop, *oop; LISTOP *lop; oop = o; @@ -605,6 +695,8 @@ STATIC OP *indirect_ck_entersub(pTHX_ OP *o) { case OP_CONST: case OP_RV2SV: case OP_PADSV: + case OP_SCOPE: + case OP_LEAVE: break; default: goto done; @@ -615,38 +707,33 @@ STATIC OP *indirect_ck_entersub(pTHX_ OP *o) { else if (mop->op_type != OP_METHOD_NAMED) goto done; - mpos = indirect_map_fetch(mop, &mnamesv); - if (!mpos) + moi = indirect_map_fetch(mop); + if (!(moi && moi->pos)) goto done; - opos = indirect_map_fetch(oop, &onamesv); - if (!opos) + ooi = indirect_map_fetch(oop); + if (!(ooi && ooi->pos)) goto done; - if (mpos < opos) { - SV *file; - line_t line; + if (indirect_is_indirect(moi, ooi)) { + SV *file; dSP; ENTER; SAVETMPS; - onamesv = sv_mortalcopy(onamesv); - mnamesv = sv_mortalcopy(mnamesv); - #ifdef USE_ITHREADS file = sv_2mortal(newSVpv(CopFILE(&PL_compiling), 0)); #else file = sv_mortalcopy(CopFILESV(&PL_compiling)); #endif - line = CopLINE(&PL_compiling); PUSHMARK(SP); EXTEND(SP, 4); - PUSHs(onamesv); - PUSHs(mnamesv); + mPUSHp(ooi->buf, ooi->len); + mPUSHp(moi->buf, moi->len); PUSHs(file); - mPUSHu(line); + mPUSHu(moi->line); PUTBACK; call_sv(code, G_VOID); @@ -693,6 +780,11 @@ BOOT: 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_entersub = PL_check[OP_ENTERSUB];