X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Findirect.git;a=blobdiff_plain;f=indirect.xs;h=00622a5c10f5b2d5b3488ed2ca40f8b600dfdffe;hp=36585193fdfaedb6bed331987d7d42b84430df9a;hb=c07766a234204d78a80b6d75534e03ae3465b6f3;hpb=ff16be2f69592b80dfcbc397b37dd4ea070b9d62

diff --git a/indirect.xs b/indirect.xs
index 3658519..00622a5 100644
--- a/indirect.xs
+++ b/indirect.xs
@@ -35,6 +35,10 @@
 # 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
@@ -260,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 (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
  {
@@ -289,10 +302,10 @@ STATIC SV *indirect_tag(pTHX_ SV *value) {
 
  /* We only need for the key to be an unique tag for looking up the value later.
   * Allocated memory provides convenient unique identifiers, so that's why we
-  * use the value pointer as the key itself. */
- ptable_hints_store(MY_CXT.tbl, value, h);
+  * use the hint as the key itself. */
+ ptable_hints_store(MY_CXT.tbl, h, h);
 
- return newSVuv(PTR2UV(value));
+ return newSViv(PTR2IV(h));
 }
 
 STATIC SV *indirect_detag(pTHX_ const SV *hint) {
@@ -300,10 +313,10 @@ STATIC SV *indirect_detag(pTHX_ const SV *hint) {
  indirect_hint_t *h;
  dMY_CXT;
 
- if (!(hint && SvOK(hint) && SvIOK(hint)))
+ if (!(hint && SvIOK(hint)))
   return NULL;
 
- h = ptable_fetch(MY_CXT.tbl, INT2PTR(void *, SvUVX(hint)));
+ h = ptable_fetch(MY_CXT.tbl, INT2PTR(void *, SvIVX(hint)));
 
 #if I_WORKAROUND_REQUIRE_PROPAGATION
  {
@@ -333,16 +346,16 @@ STATIC SV *indirect_tag(pTHX_ SV *value) {
 #define indirect_tag(V) indirect_tag(aTHX_ (V))
  UV tag = 0;
 
- if (SvOK(value) && SvROK(value)) {
+ if (SvROK(value)) {
   value = SvRV(value);
-  SvREFCNT_inc(value);
-  tag = PTR2UV(value);
+  SvREFCNT_inc_simple_NN(value);
+  tag = PTR2IV(value);
  }
 
- return newSVuv(tag);
+ return newSViv(tag);
 }
 
-#define indirect_detag(H) (((H) && SvOK(H)) ? INT2PTR(SV *, SvUVX(H)) : NULL)
+#define indirect_detag(H) (((H) && SvIOK(H)) ? INT2PTR(SV *, SvIVX(H)) : NULL)
 
 #endif /* I_THREADSAFE || I_WORKAROUND_REQUIRE_PROPAGATION */
 
@@ -600,17 +613,8 @@ STATIC OP *indirect_ck_scope(pTHX_ OP *o) {
  return o;
 }
 
-/* ... ck_leave ............................................................ */
-
-STATIC OP *(*indirect_old_ck_leave)(pTHX_ OP *) = 0;
-
-STATIC OP *indirect_ck_leave(pTHX_ OP *o) {
- o = CALL_FPTR(indirect_old_ck_leave)(aTHX_ o);
-
- /* Cleanup relevant entries in case ck_method catches them later. */
- 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 ........................................................... */
 
@@ -780,8 +784,6 @@ BOOT:
   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_leave    = PL_check[OP_LEAVE];
-  PL_check[OP_LEAVE]       = MEMBER_TO_FPTR(indirect_ck_leave);
 
   indirect_old_ck_method   = PL_check[OP_METHOD];
   PL_check[OP_METHOD]      = MEMBER_TO_FPTR(indirect_ck_method);