scope.c - add mortal_destructor_sv() and mortal_svfunc_x()

The function SAVEDESTRUCTOR_X() (save_destructor_x) can be used to
execute a C function at the end of the current psuedo-block. Prior to
this patch there was no "mortal" equivalent that would execute at the
end of the current statement. We offer a collection of functions which
are intended to free SV's at either point in time, but only support
callbacks at the end of the current pseudo-block.

This patch adds two such functions, "mortal_destructor_sv" which can be
used to trigger a perl code reference to execute at the end of the
current statement, and "mortal_svfunc_x" which can be used to trigger an
SVFUNC_t C function at the end of the current statement.

Both functions differ from save_destructor_x() in that instead of
supporting a void pointer argument they both require their argument to
be some sort of SV pointer. The Perl callback function triggered by
"mortal_destructor_sv" may be provided no arguments, a single argument
or a list of arguments, depending on the type of argument provided to
mortal_destructor_sv(): when the argument is a raw AV (with no SV ref
wrapping it), then the contents of the AV are passed in as a list of
arguments. When the argument is anything else but NULL, the argument is
provided as a single argument, and when it is NULL the perl function is
called with no arguments.

Both functions are implemented on top of a mortal SV (unseen by the
user) which has PERL_MAGIC_destruct magic associated with it, which
triggers the destructor behavior when the SV is freed.

Both functions are provided with macros to match the normal SAVExx()
API, with MORTALDESTRUCTOR_SV() wrapping mortal_destructor_sv() and
MORTALSVFUNC_X() wrapping mortal_svfunc_x().

The heart of this logic cribbed from Leon Timmermans' Variable-OnDestruct.
See the code at:

https://metacpan.org/dist/Variable-OnDestruct/source/lib/Variable/OnDestruct.xs#L6-17

I am very grateful to him for his help on this. Any errors or omissions
in this code are my fault, not his.

1 files changed, 5 insertions, 0 deletions

diff --git a/mg_vtable.h b/mg_vtable.h
index b005cb7c69..bdf8187e55 100644
--- a/mg_vtable.h
+++ b/mg_vtable.h
@@ -51,6 +51,7 @@
 #define PERL_MAGIC_vstring        'V' /* SV was vstring literal */
 #define PERL_MAGIC_vec            'v' /* vec() lvalue */
 #define PERL_MAGIC_utf8           'w' /* Cached UTF-8 information */
+#define PERL_MAGIC_destruct       'X' /* destruct callback */
 #define PERL_MAGIC_substr         'x' /* substr() lvalue */
 #define PERL_MAGIC_nonelem        'Y' /* Array element that does not exist */
 #define PERL_MAGIC_defelem        'y' /* Shadow "foreach" iterator variable /
@@ -69,6 +70,7 @@ enum {		/* pass one of these to get_vtbl */
     want_vtbl_dbline,
     want_vtbl_debugvar,
     want_vtbl_defelem,
+    want_vtbl_destruct,
     want_vtbl_env,
     want_vtbl_envelem,
     want_vtbl_hints,
@@ -107,6 +109,7 @@ EXTCONST char * const PL_magic_vtable_names[magic_vtable_max] = {
     "dbline",
     "debugvar",
     "defelem",
+    "destruct",
     "env",
     "envelem",
     "hints",
@@ -168,6 +171,7 @@ EXT_MGVTBL PL_magic_vtables[magic_vtable_max] = {
   { 0, Perl_magic_setdbline, 0, 0, 0, 0, 0, 0 },
   { Perl_magic_getdebugvar, Perl_magic_setdebugvar, 0, 0, 0, 0, 0, 0 },
   { Perl_magic_getdefelem, Perl_magic_setdefelem, 0, 0, 0, 0, 0, 0 },
+  { 0, 0, 0, 0, Perl_magic_freedestruct, 0, 0, 0 },
   { 0, Perl_magic_set_all_env, 0, Perl_magic_clear_all_env, 0, 0, 0, 0 },
   { 0, Perl_magic_setenv, 0, Perl_magic_clearenv, 0, 0, 0, 0 },
   { 0, 0, 0, Perl_magic_clearhints, 0, 0, 0, 0 },
@@ -214,6 +218,7 @@ EXT_MGVTBL PL_magic_vtables[magic_vtable_max];
 #define PL_vtbl_dbline PL_magic_vtables[want_vtbl_dbline]
 #define PL_vtbl_debugvar PL_magic_vtables[want_vtbl_debugvar]
 #define PL_vtbl_defelem PL_magic_vtables[want_vtbl_defelem]
+#define PL_vtbl_destruct PL_magic_vtables[want_vtbl_destruct]
 #define PL_vtbl_env PL_magic_vtables[want_vtbl_env]
 #define PL_vtbl_envelem PL_magic_vtables[want_vtbl_envelem]
 #define PL_vtbl_fm PL_magic_vtables[want_vtbl_fm]