Add a pluggable hook in op_free()

diff --git a/embedvar.h b/embedvar.h
index 4639c85..024b6c1 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -215,6 +215,7 @@
 #define PL_oldname             (vTHX->Ioldname)
 #define PL_op                  (vTHX->Iop)
 #define PL_op_mask             (vTHX->Iop_mask)
+#define PL_opfreehook          (vTHX->Iopfreehook)
 #define PL_opsave              (vTHX->Iopsave)
 #define PL_origalen            (vTHX->Iorigalen)
 #define PL_origargc            (vTHX->Iorigargc)
@@ -528,6 +529,7 @@
 #define PL_Ioldname            PL_oldname
 #define PL_Iop                 PL_op
 #define PL_Iop_mask            PL_op_mask
+#define PL_Iopfreehook         PL_opfreehook
 #define PL_Iopsave             PL_opsave
 #define PL_Iorigalen           PL_origalen
 #define PL_Iorigargc           PL_origargc

diff --git a/intrpvar.h b/intrpvar.h
index 7a05268..fe3f07f 100644 (file)
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -170,6 +170,8 @@ PERLVARA(Icolors,6, char *)         /* from regcomp.c */
 PERLVARI(Ipeepp,       peep_t, MEMBER_TO_FPTR(Perl_peep))
                                        /* Pointer to peephole optimizer */
 
+PERLVARI(Iopfreehook,  Perl_check_t, 0) /* op_free() hook */
+
 PERLVARI(Imaxscream,   I32,    -1)
 PERLVARI(Ireginterp_cnt,I32,    0)     /* Whether "Regexp" was interpolated. */
 PERLVARI(Iwatchaddr,   char **, 0)

diff --git a/op.c b/op.c
index 03fe906..54d2a64 100644 (file)
--- a/op.c
+++ b/op.c
@@ -103,6 +103,7 @@ recursive, but it's recursive on basic blocks, not on tree nodes.
 #include "keywords.h"
 
 #define CALL_PEEP(o) CALL_FPTR(PL_peepp)(aTHX_ o)
+#define CALL_OPFREEHOOK(o) if (PL_opfreehook) CALL_FPTR(PL_opfreehook)(aTHX_ o)
 
 #if defined(PL_OP_SLAB_ALLOC)
 
@@ -482,6 +483,11 @@ Perl_op_free(pTHX_ OP *o)
        }
     }
 
+    /* Call the op_free hook if it has been set. Do it now so that it's called
+     * at the right time for refcounted ops, but still before all of the kids
+     * are freed. */
+    CALL_OPFREEHOOK(o);
+
     if (o->op_flags & OPf_KIDS) {
         register OP *kid, *nextkid;
        for (kid = cUNOPo->op_first; kid; kid = nextkid) {

diff --git a/perlapi.h b/perlapi.h
index 27be4a2..3c0df25 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -466,6 +466,8 @@ END_EXTERN_C
 #define PL_op                  (*Perl_Iop_ptr(aTHX))
 #undef  PL_op_mask
 #define PL_op_mask             (*Perl_Iop_mask_ptr(aTHX))
+#undef  PL_opfreehook
+#define PL_opfreehook          (*Perl_Iopfreehook_ptr(aTHX))
 #undef  PL_opsave
 #define PL_opsave              (*Perl_Iopsave_ptr(aTHX))
 #undef  PL_origalen

diff --git a/sv.c b/sv.c
index bb4df7a..4699a4e 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -12326,6 +12326,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     /* Pluggable optimizer */
     PL_peepp           = proto_perl->Ipeepp;
+    /* op_free() hook */
+    PL_opfreehook      = proto_perl->Iopfreehook;
 
     PL_stashcache       = newHV();