diff options
| author | Jerry D. Hedden <jdhedden@cpan.org> | 2010-09-28 00:29:31 +0100 |
|---|---|---|
| committer | Chris 'BinGOs' Williams <chris@bingosnet.co.uk> | 2010-09-28 00:29:31 +0100 |
| commit | dfa4c01391ec1a67cfb0dc8a74a065632a21242e (patch) | |
| tree | 28f854eda9120f05663b228894a50d6ce540b7f5 /dist/threads/threads.xs | |
| parent | 38f56868e2d068edc6c54f0a547bb71e6c0a8165 (diff) | |
| download | perl-dfa4c01391ec1a67cfb0dc8a74a065632a21242e.tar.gz | |
[perl #78088] [PATCH] Upgrade to threads 1.81
[DELTA]
The attached patch makes the CPAN distribution of 'threads'
compatible with with v5.13.2 and later.
Diffstat (limited to 'dist/threads/threads.xs')
| -rw-r--r-- | dist/threads/threads.xs | 87 |
1 files changed, 84 insertions, 3 deletions
diff --git a/dist/threads/threads.xs b/dist/threads/threads.xs index 6c38bdc3fb..71fc7a7881 100644 --- a/dist/threads/threads.xs +++ b/dist/threads/threads.xs @@ -774,6 +774,36 @@ S_ithread_create( * context for the duration of our work for new interpreter. */ { +#if (PERL_VERSION < 13) || (PERL_VERSION == 13 && PERL_SUBVERSION <= 1) + CLONE_PARAMS clone_param; + + dTHXa(thread->interp); + + MY_CXT_CLONE; + + /* Here we remove END blocks since they should only run in the thread + * they are created + */ + SvREFCNT_dec(PL_endav); + PL_endav = NULL; + + clone_param.flags = 0; + if (SvPOK(init_function)) { + thread->init_function = newSV(0); + sv_copypv(thread->init_function, init_function); + } else { + thread->init_function = + SvREFCNT_inc(sv_dup(init_function, &clone_param)); + } + + thread->params = params = newAV(); + av_extend(params, params_end - params_start - 1); + AvFILLp(params) = params_end - params_start - 1; + array = AvARRAY(params); + while (params_start < params_end) { + *array++ = SvREFCNT_inc(sv_dup(*params_start++, &clone_param)); + } +#else CLONE_PARAMS *clone_param = Perl_clone_params_new(aTHX, thread->interp); dTHXa(thread->interp); @@ -800,7 +830,8 @@ S_ithread_create( while (params_start < params_end) { *array++ = SvREFCNT_inc(sv_dup(*params_start++, clone_param)); } - Perl_clone_params_del(clone_param); + Perl_clone_params_del(clone_param); +#endif #if PERL_VERSION <= 8 && PERL_SUBVERSION <= 7 /* The code below checks that anything living on the tmps stack and @@ -1239,6 +1270,28 @@ ithread_join(...) /* Get the return value from the call_sv */ /* Objects do not survive this process - FIXME */ if ((thread->gimme & G_WANT) != G_VOID) { +#if (PERL_VERSION < 13) || (PERL_VERSION == 13 && PERL_SUBVERSION <= 1) + AV *params_copy; + PerlInterpreter *other_perl; + CLONE_PARAMS clone_params; + + params_copy = thread->params; + other_perl = thread->interp; + clone_params.stashes = newAV(); + clone_params.flags = CLONEf_JOIN_IN; + PL_ptr_table = ptr_table_new(); + S_ithread_set(aTHX_ thread); + /* Ensure 'meaningful' addresses retain their meaning */ + ptr_table_store(PL_ptr_table, &other_perl->Isv_undef, &PL_sv_undef); + ptr_table_store(PL_ptr_table, &other_perl->Isv_no, &PL_sv_no); + ptr_table_store(PL_ptr_table, &other_perl->Isv_yes, &PL_sv_yes); + params = (AV *)sv_dup((SV*)params_copy, &clone_params); + S_ithread_set(aTHX_ current_thread); + SvREFCNT_dec(clone_params.stashes); + SvREFCNT_inc_void(params); + ptr_table_free(PL_ptr_table); + PL_ptr_table = NULL; +#else AV *params_copy; PerlInterpreter *other_perl = thread->interp; CLONE_PARAMS *clone_params = Perl_clone_params_new(other_perl, aTHX); @@ -1253,10 +1306,11 @@ ithread_join(...) ptr_table_store(PL_ptr_table, &other_perl->Isv_yes, &PL_sv_yes); params = (AV *)sv_dup((SV*)params_copy, clone_params); S_ithread_set(aTHX_ current_thread); - Perl_clone_params_del(clone_params); + Perl_clone_params_del(clone_params); SvREFCNT_inc_void(params); ptr_table_free(PL_ptr_table); PL_ptr_table = NULL; +#endif } /* If thread didn't die, then we can free its interpreter */ @@ -1638,6 +1692,32 @@ ithread_error(...) /* If thread died, then clone the error into the calling thread */ if (thread->state & PERL_ITHR_DIED) { +#if (PERL_VERSION < 13) || (PERL_VERSION == 13 && PERL_SUBVERSION <= 1) + PerlInterpreter *other_perl; + CLONE_PARAMS clone_params; + ithread *current_thread; + + other_perl = thread->interp; + clone_params.stashes = newAV(); + clone_params.flags = CLONEf_JOIN_IN; + PL_ptr_table = ptr_table_new(); + current_thread = S_ithread_get(aTHX); + S_ithread_set(aTHX_ thread); + /* Ensure 'meaningful' addresses retain their meaning */ + ptr_table_store(PL_ptr_table, &other_perl->Isv_undef, &PL_sv_undef); + ptr_table_store(PL_ptr_table, &other_perl->Isv_no, &PL_sv_no); + ptr_table_store(PL_ptr_table, &other_perl->Isv_yes, &PL_sv_yes); + err = sv_dup(thread->err, &clone_params); + S_ithread_set(aTHX_ current_thread); + SvREFCNT_dec(clone_params.stashes); + SvREFCNT_inc_void(err); + /* If error was an object, bless it into the correct class */ + if (thread->err_class) { + sv_bless(err, gv_stashpv(thread->err_class, 1)); + } + ptr_table_free(PL_ptr_table); + PL_ptr_table = NULL; +#else PerlInterpreter *other_perl = thread->interp; CLONE_PARAMS *clone_params = Perl_clone_params_new(other_perl, aTHX); ithread *current_thread; @@ -1652,7 +1732,7 @@ ithread_error(...) ptr_table_store(PL_ptr_table, &other_perl->Isv_yes, &PL_sv_yes); err = sv_dup(thread->err, clone_params); S_ithread_set(aTHX_ current_thread); - Perl_clone_params_del(clone_params); + Perl_clone_params_del(clone_params); SvREFCNT_inc_void(err); /* If error was an object, bless it into the correct class */ if (thread->err_class) { @@ -1660,6 +1740,7 @@ ithread_error(...) } ptr_table_free(PL_ptr_table); PL_ptr_table = NULL; +#endif } MUTEX_UNLOCK(&thread->mutex); |