From f37b8c3fdce3e5c3394f23195b5fa687fad3bd7d Mon Sep 17 00:00:00 2001
From: Vincent Pit <vince@profvince.com>
Date: Wed, 8 Jul 2009 16:49:36 +0200
Subject: [PATCH] Add a pluggable hook in op_free()

---
 embedvar.h | 2 ++
 intrpvar.h | 2 ++
 op.c       | 6 ++++++
 perlapi.h  | 2 ++
 sv.c       | 2 ++
 5 files changed, 14 insertions(+)

diff --git a/embedvar.h b/embedvar.h
index 4639c85..024b6c1 100644
--- 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
--- 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
--- 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
--- 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
--- 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();
 
-- 
1.8.3.1