X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Types.xs;h=7d50b19fdbbf1a393773dbee7a5ad6e840ac3484;hb=b1a754e228116344b847c6173904d10f7592e48e;hp=9baa8da22f7f4883d51adfaf13ed83f5fdc8621a;hpb=7cff22e4b5498f801c1d9be1dcab213a39395d0a;p=perl%2Fmodules%2FLexical-Types.git diff --git a/Types.xs b/Types.xs index 9baa8da..7d50b19 100644 --- a/Types.xs +++ b/Types.xs @@ -103,8 +103,6 @@ STATIC const lt_op_info *lt_map_fetch(pTHX_ const OP *o) { /* ... Our pp_padsv ........................................................ */ -STATIC OP *(*lt_old_pp_padsv)(pTHX) = 0; - STATIC OP *lt_pp_padsv(pTHX) { const lt_op_info *oi; @@ -121,9 +119,9 @@ STATIC OP *lt_pp_padsv(pTHX) { PUSHMARK(SP); EXTEND(SP, 3); - PUSHs(sv_2mortal(newSVsv(oi->type_pkg))); + PUSHs(oi->type_pkg); PUSHs(sv); - PUSHs(sv_2mortal(newSVsv(oi->orig_pkg))); + PUSHs(oi->orig_pkg); PUTBACK; items = call_sv(oi->type_meth, G_ARRAY | G_METHOD); @@ -147,7 +145,28 @@ STATIC OP *lt_pp_padsv(pTHX) { return CALL_FPTR(oi->pp_padsv)(aTHX); } - return CALL_FPTR(lt_old_pp_padsv)(aTHX); + return CALL_FPTR(PL_ppaddr[OP_PADSV])(aTHX); +} + +STATIC OP *(*lt_pp_padsv_saved)(pTHX) = 0; + +STATIC void lt_pp_padsv_save(void) { + if (lt_pp_padsv_saved) + return; + + lt_pp_padsv_saved = PL_ppaddr[OP_PADSV]; + PL_ppaddr[OP_PADSV] = lt_pp_padsv; +} + +STATIC void lt_pp_padsv_restore(OP *o) { + if (!lt_pp_padsv_saved) + return; + + if (o->op_ppaddr == lt_pp_padsv) + o->op_ppaddr = lt_pp_padsv_saved; + + PL_ppaddr[OP_PADSV] = lt_pp_padsv_saved; + lt_pp_padsv_saved = 0; } /* ... Our ck_pad{any,sv} .................................................. */ @@ -160,7 +179,7 @@ STATIC OP *lt_pp_padsv(pTHX) { * pp_padsv, but much less than if we would have set PL_ppaddr[OP_PADSV] * globally. */ -STATIC U32 lt_TYPEDSCALAR_hash = 0; +STATIC SV *lt_default_meth = NULL; STATIC OP *(*lt_old_ck_padany)(pTHX_ OP *) = 0; @@ -168,20 +187,19 @@ STATIC OP *lt_ck_padany(pTHX_ OP *o) { HV *stash; SV *hint; - PL_ppaddr[OP_PADSV] = lt_old_pp_padsv; + lt_pp_padsv_restore(o); o = CALL_FPTR(lt_old_ck_padany)(aTHX_ o); stash = PL_in_my_stash; if (stash && (hint = lt_hint())) { SV *orig_pkg = newSVpvn(HvNAME_get(stash), HvNAMELEN_get(stash)); - SV *orig_meth = newSVpvn_share("TYPEDSCALAR", 11, lt_TYPEDSCALAR_hash); + SV *orig_meth = lt_default_meth; SV *type_pkg = orig_pkg; SV *type_meth = orig_meth; SV *code = INT2PTR(SV *, SvUVX(hint)); SvREADONLY_on(orig_pkg); - SvREADONLY_on(orig_meth); if (code) { int items; @@ -203,18 +221,21 @@ STATIC OP *lt_ck_padany(pTHX_ OP *o) { croak(__PACKAGE__ " mangler should return zero, one or two scalars, but got %d", items); if (items == 0) { SvREFCNT_dec(orig_pkg); - SvREFCNT_dec(orig_meth); goto skip; } else { SV *rsv; if (items > 1) { rsv = POPs; - if (SvOK(rsv)) + if (SvOK(rsv)) { type_meth = newSVsv(rsv); + SvREADONLY_on(type_meth); + } } rsv = POPs; - if (SvOK(rsv)) + if (SvOK(rsv)) { type_pkg = newSVsv(rsv); + SvREADONLY_on(type_pkg); + } } PUTBACK; @@ -222,9 +243,12 @@ STATIC OP *lt_ck_padany(pTHX_ OP *o) { LEAVE; } - lt_old_pp_padsv = PL_ppaddr[OP_PADSV]; - lt_map_store(o, orig_pkg, type_pkg, type_meth, lt_old_pp_padsv); - PL_ppaddr[OP_PADSV] = lt_pp_padsv; + if (type_meth == orig_meth) + SvREFCNT_inc(orig_meth); + + lt_pp_padsv_save(); + + lt_map_store(o, orig_pkg, type_pkg, type_meth, lt_pp_padsv_saved); } skip: @@ -234,7 +258,8 @@ skip: STATIC OP *(*lt_old_ck_padsv)(pTHX_ OP *) = 0; STATIC OP *lt_ck_padsv(pTHX_ OP *o) { - PL_ppaddr[OP_PADSV] = lt_old_pp_padsv; + lt_pp_padsv_restore(o); + return CALL_FPTR(lt_old_ck_padsv)(aTHX_ o); } @@ -249,7 +274,8 @@ PROTOTYPES: DISABLE BOOT: { if (!lt_initialized++) { - PERL_HASH(lt_TYPEDSCALAR_hash, "TYPEDSCALAR", 11); + lt_default_meth = newSVpvn("TYPEDSCALAR", 11); + SvREADONLY_on(lt_default_meth); PERL_HASH(lt_hash, __PACKAGE__, __PACKAGE_LEN__); lt_op_map = newHV(); @@ -258,7 +284,6 @@ BOOT: PL_check[OP_PADANY] = MEMBER_TO_FPTR(lt_ck_padany); lt_old_ck_padsv = PL_check[OP_PADSV]; PL_check[OP_PADSV] = MEMBER_TO_FPTR(lt_ck_padsv); - lt_old_pp_padsv = PL_ppaddr[OP_PADSV]; } }