develooper Front page | perl.perl5.porters | Postings from May 2016

[PATCH] - fix for Coro (was Re: revert MG consting (Coro breakage)for 5.24?)

Thread Previous | Thread Next
From:
Nicholas Clark
Date:
May 4, 2016 19:27
Subject:
[PATCH] - fix for Coro (was Re: revert MG consting (Coro breakage)for 5.24?)
Message ID:
20160504192704.GR2048@ceres.etla.org
On Wed, May 04, 2016 at 04:37:47PM -0000, Father Chrysostomos wrote:
> Nicholas Clark wrote:
> > So, to do *that*, it overrides the core magic on %SIG to behave differently,
> > to facilitate the way that it would like the world to be.
> 
> Which is not that hard to do even with a const magic vtable.  Just
> create a custom magic vtable that mirrors the core sig vtable, except
> for that one entry, and use that.  So the consting of the vtable (the
> subject of this thread) is irrelevant.  (Caveat: I have not tested any
> of this.)

Thanks, that's the part that I was missing. Oh, and setting MGf_COPY on
mg_flags.

The core sig vtable is all zeros. That's trivially easy to mirror :-)

So, THIS WORKS.

I have commit 73949fca082fe50bf47755c5ffa328259057ae36 cherry-picked onto
v5.22.0:

c813842 (HEAD) make PadlistNAMES() lvalue again.
70f63a4 (tag: v5.22.0) Coro is known broken on blead


I make the appended change to Coro.
It builds.
It passes tests.
I tested t/13_diewarn.t with valgrind and nothing is reported.
And if I add sv_dump in the coro_sigelem_set I know that it's being called.

I appreciate that it doesn't quite match Marc's coding style, and I've not
tested it with anything other than v5.22.0-1-gc813842
so I don't know how much conditional coding might be needed to get it working
on v5.20.x back to v5.10.0

but, heck, it works, and the rest of if *is* a SMOP that many many folks
reading this could do, if they wanted to.

I believe that Marc is no longer interested in supporting Perl v5.22.0 and
later. If so, that's fine - that's his call.

But if anyone else would locally like to build Coro for v5.22.0 and later,
I hope that this is of use.

Nicholas Clark

--- Coro/State.xs.orig	2015-10-16 09:33:17.000000000 +0200
+++ Coro/State.xs	2016-05-04 21:23:26.636210038 +0200
@@ -1029,10 +1029,6 @@
 
 /** coroutine stack handling ************************************************/
 
-static int (*orig_sigelem_get) (pTHX_ SV *sv, MAGIC *mg);
-static int (*orig_sigelem_set) (pTHX_ SV *sv, MAGIC *mg);
-static int (*orig_sigelem_clr) (pTHX_ SV *sv, MAGIC *mg);
-
 /* apparently < 5.8.8 */
 #ifndef MgPV_nolen_const
 #define MgPV_nolen_const(mg)    (((((int)(mg)->mg_len)) == HEf_SVKEY) ?   \
@@ -1074,7 +1070,7 @@
         }
     }
 
-  return orig_sigelem_get ? orig_sigelem_get (aTHX_ sv, mg) : 0;
+  return PL_vtbl_sigelem.svt_get ? PL_vtbl_sigelem.svt_get (aTHX_ sv, mg) : 0;
 }
 
 static int ecb_cold
@@ -1098,7 +1094,7 @@
         }
     }
 
-  return orig_sigelem_clr ? orig_sigelem_clr (aTHX_ sv, mg) : 0;
+  return PL_vtbl_sigelem.svt_clear ? PL_vtbl_sigelem.svt_clear (aTHX_ sv, mg) : 0;
 }
 
 static int ecb_cold
@@ -1122,9 +1118,41 @@
         }
     }
 
-  return orig_sigelem_set ? orig_sigelem_set (aTHX_ sv, mg) : 0;
+  return PL_vtbl_sigelem.svt_set ? PL_vtbl_sigelem.svt_set (aTHX_ sv, mg) : 0;
 }
 
+static MGVTBL sigelem_vtbl = {
+    coro_sigelem_get,           /* get */
+    coro_sigelem_set,           /* set */
+    0,                          /* len */
+    coro_sigelem_clr,           /* clear */
+    0,                          /* free */
+    0,                          /* copy */
+    0,                          /* dup */
+#ifdef MGf_LOCAL
+    0,                          /* local */
+#endif
+};
+
+static int ecb_cold
+coro_sig_copy (pTHX_ SV *sv, MAGIC *mg, SV *nsv, const char *key, I32 klen)
+{
+  return sv_magicext (nsv, mg->mg_obj, 'u', &sigelem_vtbl, key, klen);
+}
+
+static MGVTBL sig_vtbl = {
+    0,                          /* get */
+    0,                          /* set */
+    0,                          /* len */
+    0,                          /* clear */
+    0,                          /* free */
+    coro_sig_copy,              /* copy */
+    0,                          /* dup */
+#ifdef MGf_LOCAL
+    0,                          /* local */
+#endif
+};
+
 static void
 prepare_nop (pTHX_ struct coro_transfer_args *ta)
 {
@@ -3596,15 +3624,16 @@
         DEFSV;
         ERRSV;
 
+        HV *sig = GvHV (gv_fetchpv ("SIG", GV_ADD|GV_NOTQUAL, SVt_PVHV));
+        
+        sv_unmagic ((SV *)sig, PERL_MAGIC_sig);
+        sv_magicext ((SV *)sig, NULL, PERL_MAGIC_uvar, &sig_vtbl, NULL, 0)->mg_flags |= MGf_COPY;
+
         cctx_current = cctx_new_empty ();
 
         irsgv    = gv_fetchpv ("/"     , GV_ADD|GV_NOTQUAL, SVt_PV);
         stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
 
-        orig_sigelem_get = PL_vtbl_sigelem.svt_get;   PL_vtbl_sigelem.svt_get   = coro_sigelem_get;
-        orig_sigelem_set = PL_vtbl_sigelem.svt_set;   PL_vtbl_sigelem.svt_set   = coro_sigelem_set;
-        orig_sigelem_clr = PL_vtbl_sigelem.svt_clear; PL_vtbl_sigelem.svt_clear = coro_sigelem_clr;
-
         rv_diehook  = newRV_inc ((SV *)gv_fetchpv ("Coro::State::diehook" , 0, SVt_PVCV));
         rv_warnhook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::warnhook", 0, SVt_PVCV));
 

Thread Previous | Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About