From 680818c0361b180bb6f09d4bb11c4d5cd467fe62 Mon Sep 17 00:00:00 2001
From: Nicholas Clark <nick@ccl4.org>
Date: Thu, 13 Jan 2011 16:24:52 +0000
Subject: [PATCH] ithread_create() was relying on the stack not moving. Fix
 this.

4cf5eae5e58faebb changed S_ithread_create() to avoid creating an AV, by
passing the thread creation arguments as pointers to a block of memory
holding SVs. Unfortunately, this inadvertently introduced a subtle bug,
because the block of memory is on the Perl stack, which can move as a side
effect of being reallocated to extend it. Hence pass in the offset on the
stack instead, read the current value of the relevant interpreter's stack
at the point of access, and copy all the SVs away before making any further
calls which might cause reallocation.
---
 dist/threads/threads.xs | 46 +++++++++++++++++++++++++---------------------
 1 file changed, 25 insertions(+), 21 deletions(-)

diff --git a/dist/threads/threads.xs b/dist/threads/threads.xs
index 9ee714d..226f796 100644
--- a/dist/threads/threads.xs
+++ b/dist/threads/threads.xs
@@ -676,13 +676,15 @@ S_SV_to_ithread(pTHX_ SV *sv)
  */
 STATIC ithread *
 S_ithread_create(
-        pTHX_ SV *init_function,
+        PerlInterpreter *parent_perl,
+        SV       *init_function,
         IV        stack_size,
         int       gimme,
         int       exit_opt,
-        SV      **params_start,
-        SV      **params_end)
+        int       params_start,
+        int       num_params)
 {
+    dTHXa(parent_perl);
     ithread     *thread;
     ithread     *current_thread = S_ithread_get(aTHX);
     AV          *params;
@@ -782,8 +784,8 @@ S_ithread_create(
 #if (PERL_VERSION > 13) || (PERL_VERSION == 13 && PERL_SUBVERSION > 1)
         CLONE_PARAMS *clone_param = Perl_clone_params_new(aTHX, thread->interp);
 #else
-	CLONE_PARAMS clone_param_s;
-	CLONE_PARAMS *clone_param = &clone_param_s;
+        CLONE_PARAMS clone_param_s;
+        CLONE_PARAMS *clone_param = &clone_param_s;
 
         clone_param->flags = 0;
 #endif
@@ -806,11 +808,22 @@ S_ithread_create(
         }
 
         thread->params = params = newAV();
-        av_extend(params, params_end - params_start - 1);
-        AvFILLp(params) = params_end - params_start - 1;
+        av_extend(params, num_params - 1);
+        AvFILLp(params) = num_params - 1;
         array = AvARRAY(params);
-        while (params_start < params_end) {
-            *array++ = SvREFCNT_inc(sv_dup(*params_start++, clone_param));
+
+        /* params_start is an offset onto the Perl stack. This can be
+           reallocated (and hence move) as a side effect of calls to
+           perl_clone() and sv_dup_inc(). Hence copy the parameters
+           somewhere under our control first, before duplicating.  */
+#if (PERL_VERSION > 8)
+        Copy(parent_perl->Istack_base + params_start, array, num_params, SV *);
+#else
+        Copy(parent_perl->Tstack_base + params_start, array, num_params, SV *);
+#endif
+        while (num_params--) {
+            *array = sv_dup_inc(*array, clone_param);
+            ++array;
         }
 #if (PERL_VERSION > 13) || (PERL_VERSION == 13 && PERL_SUBVERSION > 1)
         Perl_clone_params_del(clone_param);
@@ -968,8 +981,7 @@ ithread_create(...)
         SV *thread_exit_only;
         char *str;
         int idx;
-        SV **args_start;
-        SV **args_end;
+        unsigned int num_args;
         dMY_POOL;
     CODE:
         if ((items >= 2) && SvROK(ST(1)) && SvTYPE(SvRV(ST(1)))==SVt_PVHV) {
@@ -1069,22 +1081,14 @@ ithread_create(...)
             context |= (GIMME_V & (~(G_ARRAY|G_SCALAR|G_VOID)));
         }
 
-        /* Function args */
-        args_start = &ST(idx + 2);
-        if (items > 2) {
-            args_end = &ST(idx + items);
-        } else {
-            args_end = args_start;
-        }
-
         /* Create thread */
         MUTEX_LOCK(&MY_POOL.create_destruct_mutex);
         thread = S_ithread_create(aTHX_ function_to_call,
                                         stack_size,
                                         context,
                                         exit_opt,
-                                        args_start,
-                                        args_end);
+                                        ax + idx + 2,
+                                        items > 2 ? items - 2 : 0);
         if (! thread) {
             XSRETURN_UNDEF;     /* Mutex already unlocked */
         }
-- 
2.7.4