diff options
| -rw-r--r-- | embedvar.h | 2 | ||||
| -rw-r--r-- | intrpvar.h | 2 | ||||
| -rw-r--r-- | op.c | 6 | ||||
| -rw-r--r-- | perlapi.h | 2 | ||||
| -rw-r--r-- | sv.c | 2 |
5 files changed, 14 insertions, 0 deletions
diff --git a/embedvar.h b/embedvar.h index 4639c85dfd..024b6c1d90 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 7a0526811b..fe3f07f5eb 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) @@ -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) { @@ -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 @@ -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(); |