Cleaner implementations for Perl_clone_params_{new,del}

Not source or binary compatible with maint-5.12.

diff --git a/sv.c b/sv.c
index a1f7970..d21c945 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -12644,43 +12644,25 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     return my_perl;
 }
 
-/* An initial implementation suitable for ppport.h, which doesn't make any
-   assumptions about a new structure member existing, and not being garbage.  */
-#define CLONE_PARAMS_PRIVATE 0xFE60
-
 void
 Perl_clone_params_del(CLONE_PARAMS *param)
 {
     PerlInterpreter *const was = PERL_GET_THX;
-    /* mg_find starts PERL_UNUSED_CONTEXT, so this first argument doesn't
-       actually matter.  */
-    MAGIC *mg = Perl_mg_find(param->proto_perl, MUTABLE_SV(param->stashes),
-                            PERL_MAGIC_ext);
-    PerlInterpreter *const to = mg && mg->mg_private == CLONE_PARAMS_PRIVATE
-       ? (PerlInterpreter *) mg->mg_ptr : NULL;
+    PerlInterpreter *const to = param->new_perl;
+    dTHXa(to);
 
     PERL_ARGS_ASSERT_CLONE_PARAMS_DEL;
 
-    if (to) {
-       dTHXa(to);
+    if (was != to) {
+       PERL_SET_THX(to);
+    }
 
-       if (was != to) {
-           PERL_SET_THX(to);
-       }
+    SvREFCNT_dec(param->stashes);
 
-       SvREFCNT_dec(param->stashes);
-       Safefree(param);
+    Safefree(param);
 
-       if (was != to) {
-           PERL_SET_THX(was);
-       }
-    } else {
-       /* Have to assume/hope that this is going to work with whatever
-          interpreter we currently have set.  Should never get here anyway.  */
-       dTHXa(PERL_GET_CONTEXT);
-
-       SvREFCNT_dec(param->stashes);
-       Safefree(param);
+    if (was != to) {
+       PERL_SET_THX(was);
     }
 }
 
@@ -12693,7 +12675,6 @@ Perl_clone_params_new(PerlInterpreter *const from, PerlInterpreter *const to)
        a version that passes in my_perl.  */
     PerlInterpreter *const was = PERL_GET_THX;
     CLONE_PARAMS *param;
-    MAGIC *mg;
 
     PERL_ARGS_ASSERT_CLONE_PARAMS_NEW;
 
@@ -12706,14 +12687,10 @@ Perl_clone_params_new(PerlInterpreter *const from, PerlInterpreter *const to)
 
     param->flags = 0;
     param->proto_perl = from;
+    param->new_perl = to;
     param->stashes = (AV *)Perl_newSV_type(to, SVt_PVAV);
     AvREAL_off(param->stashes);
 
-    mg = Perl_sv_magicext(to, MUTABLE_SV(param->stashes), 0, PERL_MAGIC_ext,
-                         NULL, (char *)to, 0);
-    if (mg)
-       mg->mg_private = CLONE_PARAMS_PRIVATE;
-
     if (was != to) {
        PERL_SET_THX(was);
     }

diff --git a/sv.h b/sv.h
index cc7edb9..744687a 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -1939,6 +1939,7 @@ struct clone_params {
   AV* stashes;
   UV  flags;
   PerlInterpreter *proto_perl;
+  PerlInterpreter *new_perl;
 };
 
 /*