From: Vincent Pit <vince@profvince.com>
Date: Sun, 12 Aug 2012 17:14:00 +0000 (+0200)
Subject: Make the 'reset RMG flag' workaround thread-safe
X-Git-Tag: v0.51~4
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FVariable-Magic.git;a=commitdiff_plain;h=7bd7c3d822cc5f91b1ebf227e3756d2ef6e977e1

Make the 'reset RMG flag' workaround thread-safe

This uses trampoline ops for threaded perls, where it is not allowed to
modify the contents PL_op points to, but just what PL_op points at.
---

diff --git a/Magic.xs b/Magic.xs
index 1091f15..15d51ca 100644
--- a/Magic.xs
+++ b/Magic.xs
@@ -220,6 +220,48 @@ STATIC void vmg_mg_magical(SV *sv) {
 
 #endif
 
+/* ... Trampoline ops ...................................................... */
+
+/* NewOp() isn't public in perl 5.8.0. */
+#define VMG_RESET_RMG_NEEDS_TRAMPOLINE (VMG_UVAR && (VMG_THREADSAFE || !VMG_HAS_PERL(5, 8, 1)))
+
+#define VMG_NEEDS_TRAMPOLINE VMG_RESET_RMG_NEEDS_TRAMPOLINE
+
+#if VMG_NEEDS_TRAMPOLINE
+
+typedef struct {
+ OP   temp;
+ SVOP target;
+} vmg_trampoline;
+
+STATIC void vmg_trampoline_init(vmg_trampoline *t, OP *(*cb)(pTHX)) {
+ t->temp.op_type    = OP_STUB;
+ t->temp.op_ppaddr  = 0;
+ t->temp.op_next    = (OP *) &t->target;
+ t->temp.op_flags   = 0;
+ t->temp.op_private = 0;
+
+ t->target.op_type    = OP_STUB;
+ t->target.op_ppaddr  = cb;
+ t->target.op_next    = NULL;
+ t->target.op_flags   = 0;
+ t->target.op_private = 0;
+ t->target.op_sv      = NULL;
+}
+
+STATIC OP *vmg_trampoline_bump(pTHX_ vmg_trampoline *t, SV *sv, OP *o) {
+#define vmg_trampoline_bump(T, S, O) vmg_trampoline_bump(aTHX_ (T), (S), (O))
+ t->temp         = *o;
+ t->temp.op_next = (OP *) &t->target;
+
+ t->target.op_sv   = sv;
+ t->target.op_next = o->op_next;
+
+ return &t->temp;
+}
+
+#endif /* VMG_NEEDS_TRAMPOLINE */
+
 /* ... Safe version of call_sv() ........................................... */
 
 STATIC I32 vmg_call_sv(pTHX_ SV *sv, I32 flags, int (*cleanup)(pTHX_ void *), void *ud) {
@@ -401,9 +443,12 @@ STATIC const char vmg_argstorefailed[] = "Error while storing arguments";
 #define MY_CXT_KEY __PACKAGE__ "::_guts" XS_VERSION
 
 typedef struct {
- HV    *b__op_stashes[OPc_MAX];
- I32    depth;
- MAGIC *freed_tokens;
+ HV             *b__op_stashes[OPc_MAX];
+ I32             depth;
+ MAGIC          *freed_tokens;
+#if VMG_RESET_RMG_NEEDS_TRAMPOLINE
+ vmg_trampoline  reset_rmg;
+#endif
 } my_cxt_t;
 
 START_MY_CXT
@@ -1536,6 +1581,15 @@ STATIC I32 vmg_svt_val(pTHX_ IV action, SV *sv) {
    * mistaken for a tied hash by the rest of hv_common. It will be reset by
    * the op_ppaddr of a new fake op injected between the current and the next
    * one. */
+
+#if VMG_RESET_RMG_NEEDS_TRAMPOLINE
+
+  dMY_CXT;
+
+  PL_op = vmg_trampoline_bump(&MY_CXT.reset_rmg, sv, PL_op);
+
+#else /* !VMG_RESET_RMG_NEEDS_TRAMPOLINE */
+
   OP   *nop  = PL_op->op_next;
   SVOP *svop = NULL;
 
@@ -1554,6 +1608,8 @@ STATIC I32 vmg_svt_val(pTHX_ IV action, SV *sv) {
 
   svop->op_sv = sv;
 
+#endif /* VMG_RESET_RMG_NEEDS_TRAMPOLINE */
+
   SvRMAGICAL_off(sv);
  }
 
@@ -1619,8 +1675,16 @@ BOOT:
  MY_CXT_INIT;
  for (c = OPc_NULL; c < OPc_MAX; ++c)
   MY_CXT.b__op_stashes[c] = NULL;
+
  MY_CXT.depth        = 0;
  MY_CXT.freed_tokens = NULL;
+
+ /* XS doesn't like a blank line here */
+#if VMG_RESET_RMG_NEEDS_TRAMPOLINE
+ vmg_trampoline_init(&MY_CXT.reset_rmg, vmg_pp_reset_rmg);
+#endif
+
+ /* XS doesn't like a blank line here */
 #if VMG_THREADSAFE
  MUTEX_INIT(&vmg_vtable_refcount_mutex);
  MUTEX_INIT(&vmg_op_name_init_mutex);