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.

diff --git a/dist/threads/threads.xs b/dist/threads/threads.xs
index 9ee714d..226f796 100644 (file)
--- 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(
  */
 STATIC ithread *
 S_ithread_create(

-        pTHX_ SV *init_function,
+        PerlInterpreter *parent_perl,
+        SV       *init_function,

         IV        stack_size,
         int       gimme,
         int       exit_opt,
         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;
     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
 #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
 
         clone_param->flags = 0;
 #endif


@@ -806,11 +808,22 @@ S_ithread_create(
         }
 
         thread->params = params = newAV();
         }
 
         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);
         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);
         }
 #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 *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) {
         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)));
         }
 
             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,
         /* 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 */
         }
         if (! thread) {
             XSRETURN_UNDEF;     /* Mutex already unlocked */
         }