Author: gozer
Date: Mon Feb 11 00:51:08 2008
New Revision: 620440
URL: http://svn.apache.org/viewvc?rev=620440&view=rev
Log:
Fix a crash when spawning Perl threads under Perl 5.10.
The way we used to stash a pointer to the current modperl_interp_t into
the current PerlInterpreter * relied on HvPMROOT or stashing things
in unused fields of PL_modglobal.
This borked under 5.10, as there was no unused fields left to use,
and things had moved from under our feet.
This patches changes the implementation to using PL_modglobal, a
per-interpreter hash specifically designed for this purpose.
Modified:
perl/modperl/trunk/Changes
perl/modperl/trunk/lib/ModPerl/WrapXS.pm
perl/modperl/trunk/src/modules/perl/mod_perl.c
perl/modperl/trunk/src/modules/perl/mod_perl.h
perl/modperl/trunk/src/modules/perl/modperl_interp.c
perl/modperl/trunk/src/modules/perl/modperl_interp.h
perl/modperl/trunk/xs/APR/Pool/APR__Pool.h
perl/modperl/trunk/xs/tables/current/ModPerl/FunctionTable.pm
Modified: perl/modperl/trunk/Changes
URL:
http://svn.apache.org/viewvc/perl/modperl/trunk/Changes?rev=620440&r1=620439&r2=620440&view=diff
==============================================================================
--- perl/modperl/trunk/Changes (original)
+++ perl/modperl/trunk/Changes Mon Feb 11 00:51:08 2008
@@ -12,6 +12,9 @@
=item 2.0.4-dev
+Fix a crash when spawning Perl threads under Perl 5.10
+[Gozer]
+
Fix erratic behaviour when filters were used with Perl 5.10
[Gozer]
Modified: perl/modperl/trunk/lib/ModPerl/WrapXS.pm
URL:
http://svn.apache.org/viewvc/perl/modperl/trunk/lib/ModPerl/WrapXS.pm?rev=620440&r1=620439&r2=620440&view=diff
==============================================================================
--- perl/modperl/trunk/lib/ModPerl/WrapXS.pm (original)
+++ perl/modperl/trunk/lib/ModPerl/WrapXS.pm Mon Feb 11 00:51:08 2008
@@ -597,6 +597,7 @@
if ($module eq 'APR::Pool') {
print $fh " modperl_opt_interp_unselect =
APR_RETRIEVE_OPTIONAL_FN(modperl_interp_unselect);\n\n";
+ print $fh " modperl_opt_thx_interp_get =
APR_RETRIEVE_OPTIONAL_FN(modperl_thx_interp_get);\n\n";
}
close $fh;
Modified: perl/modperl/trunk/src/modules/perl/mod_perl.c
URL:
http://svn.apache.org/viewvc/perl/modperl/trunk/src/modules/perl/mod_perl.c?rev=620440&r1=620439&r2=620440&view=diff
==============================================================================
--- perl/modperl/trunk/src/modules/perl/mod_perl.c (original)
+++ perl/modperl/trunk/src/modules/perl/mod_perl.c Mon Feb 11 00:51:08 2008
@@ -835,6 +835,7 @@
#ifdef USE_ITHREADS
APR_REGISTER_OPTIONAL_FN(modperl_interp_unselect);
+ APR_REGISTER_OPTIONAL_FN(modperl_thx_interp_get);
#endif
/* for <IfDefine MODPERL2> and Apache2->define("MODPERL2") */
Modified: perl/modperl/trunk/src/modules/perl/mod_perl.h
URL:
http://svn.apache.org/viewvc/perl/modperl/trunk/src/modules/perl/mod_perl.h?rev=620440&r1=620439&r2=620440&view=diff
==============================================================================
--- perl/modperl/trunk/src/modules/perl/mod_perl.h (original)
+++ perl/modperl/trunk/src/modules/perl/mod_perl.h Mon Feb 11 00:51:08 2008
@@ -149,6 +149,7 @@
#define MODPERL_HOOK_REALLY_REALLY_FIRST (-20)
APR_DECLARE_OPTIONAL_FN(apr_status_t,modperl_interp_unselect,(void *));
+APR_DECLARE_OPTIONAL_FN(modperl_interp_t
*,modperl_thx_interp_get,(PerlInterpreter *));
/*
* perl context overriding and restoration is required when
Modified: perl/modperl/trunk/src/modules/perl/modperl_interp.c
URL:
http://svn.apache.org/viewvc/perl/modperl/trunk/src/modules/perl/modperl_interp.c?rev=620440&r1=620439&r2=620440&view=diff
==============================================================================
--- perl/modperl/trunk/src/modules/perl/modperl_interp.c (original)
+++ perl/modperl/trunk/src/modules/perl/modperl_interp.c Mon Feb 11 00:51:08
2008
@@ -291,7 +291,7 @@
MpInterpIN_USE_Off(interp);
MpInterpPUTBACK_Off(interp);
- MP_THX_INTERP_SET(interp->perl, NULL);
+ modperl_thx_interp_set(interp->perl, NULL);
modperl_tipool_putback_data(mip->tipool, data, interp->num_requests);
@@ -506,7 +506,7 @@
/* set context (THX) for this thread */
PERL_SET_CONTEXT(interp->perl);
- MP_THX_INTERP_SET(interp->perl, interp);
+ modperl_thx_interp_set(interp->perl, interp);
return interp;
}
@@ -573,6 +573,24 @@
s = s->next;
}
+}
+
+#define MP_THX_INTERP_KEY "modperl2::thx_interp_key"
+modperl_interp_t *modperl_thx_interp_get(PerlInterpreter *thx)
+{
+ modperl_interp_t *interp;
+ dTHXa(thx);
+ SV **svp = hv_fetch(PL_modglobal, MP_THX_INTERP_KEY,
strlen(MP_THX_INTERP_KEY), 0);
+ if (!svp) return;
+ interp = INT2PTR(modperl_interp_t *, SvIV(*svp));
+ return interp;
+}
+
+void modperl_thx_interp_set(PerlInterpreter *thx, modperl_interp_t *interp)
+{
+ dTHXa(thx);
+ hv_store(PL_modglobal, MP_THX_INTERP_KEY, strlen(MP_THX_INTERP_KEY),
newSViv(PTR2IV(interp)), 0);
+ return;
}
#else
Modified: perl/modperl/trunk/src/modules/perl/modperl_interp.h
URL:
http://svn.apache.org/viewvc/perl/modperl/trunk/src/modules/perl/modperl_interp.h?rev=620440&r1=620439&r2=620440&view=diff
==============================================================================
--- perl/modperl/trunk/src/modules/perl/modperl_interp.h (original)
+++ perl/modperl/trunk/src/modules/perl/modperl_interp.h Mon Feb 11 00:51:08
2008
@@ -24,42 +24,8 @@
#ifdef USE_ITHREADS
-/*
- * HvPMROOT will never be used by Perl with PL_modglobal.
- * so we have stolen it as a quick way to stash the interp
- * pointer.
- *
- * However in 5.9.3 HvPMROOT was completely removed, so we have moved
- * to use another struct member that's hopefully won't be used by
- * anybody else. But if we can find a better place to store the
- * pointer to the current mod_perl interpreter object it'd be a much
- * cleaner solution. of course it must be really fast.
- */
-#ifndef HvPMROOT
-# if MP_PERL_VERSION_AT_LEAST(5, 9, 5)
-#define MP_THX_INTERP_GET(thx) \
- (modperl_interp_t *)
((XPVMG*)SvANY(*Perl_Imodglobal_ptr(thx)))->xmg_u.xmg_magic
-# else
-#define MP_THX_INTERP_GET(thx) \
- (modperl_interp_t *)
((XPVMG*)SvANY(*Perl_Imodglobal_ptr(thx)))->xmg_magic
-# endif
-#else
-#define MP_THX_INTERP_GET(thx) \
- (modperl_interp_t *)HvPMROOT(*Perl_Imodglobal_ptr(thx))
-#endif
-
-#ifndef HvPMROOT
-# if MP_PERL_VERSION_AT_LEAST(5, 9, 5)
-#define MP_THX_INTERP_SET(thx, interp) \
- ((XPVMG*)SvANY(*Perl_Imodglobal_ptr(thx)))->xmg_u.xmg_magic =
(MAGIC*)interp
-# else
-#define MP_THX_INTERP_SET(thx, interp) \
- ((XPVMG*)SvANY(*Perl_Imodglobal_ptr(thx)))->xmg_magic = (MAGIC*)interp
-# endif
-#else
-#define MP_THX_INTERP_SET(thx, interp) \
- HvPMROOT(*Perl_Imodglobal_ptr(thx)) = (PMOP*)interp
-#endif
+modperl_interp_t *modperl_thx_interp_get(PerlInterpreter *thx);
+void modperl_thx_interp_set(PerlInterpreter *thx, modperl_interp_t *interp);
const char *modperl_interp_scope_desc(modperl_interp_scope_e scope);
Modified: perl/modperl/trunk/xs/APR/Pool/APR__Pool.h
URL:
http://svn.apache.org/viewvc/perl/modperl/trunk/xs/APR/Pool/APR__Pool.h?rev=620440&r1=620439&r2=620440&view=diff
==============================================================================
--- perl/modperl/trunk/xs/APR/Pool/APR__Pool.h (original)
+++ perl/modperl/trunk/xs/APR/Pool/APR__Pool.h Mon Feb 11 00:51:08 2008
@@ -42,6 +42,7 @@
#include "apr_optional.h"
static
APR_OPTIONAL_FN_TYPE(modperl_interp_unselect) *modperl_opt_interp_unselect;
+APR_OPTIONAL_FN_TYPE(modperl_thx_interp_get) *modperl_opt_thx_interp_get;
#endif
#define MP_APR_POOL_SV_HAS_OWNERSHIP(sv) mpxs_pool_is_custom(sv)
@@ -95,8 +96,10 @@
/* make sure interpreter is not putback into the mip \
* until this cleanup has run. \
*/ \
- if ((acct->interp = MP_THX_INTERP_GET(aTHX))) { \
- acct->interp->refcnt++; \
+ if (modperl_opt_thx_interp_get) { \
+ if ((acct->interp = modperl_opt_thx_interp_get(aTHX))) { \
+ acct->interp->refcnt++; \
+ } \
} \
} STMT_END
@@ -335,8 +338,10 @@
/* make sure interpreter is not putback into the mip
* until this cleanup has run.
*/
- if ((data->interp = MP_THX_INTERP_GET(data->perl))) {
- data->interp->refcnt++;
+ if (modperl_opt_thx_interp_get) {
+ if ((data->interp = modperl_opt_thx_interp_get(data->perl))) {
+ data->interp->refcnt++;
+ }
}
#endif
Modified: perl/modperl/trunk/xs/tables/current/ModPerl/FunctionTable.pm
URL:
http://svn.apache.org/viewvc/perl/modperl/trunk/xs/tables/current/ModPerl/FunctionTable.pm?rev=620440&r1=620439&r2=620440&view=diff
==============================================================================
--- perl/modperl/trunk/xs/tables/current/ModPerl/FunctionTable.pm (original)
+++ perl/modperl/trunk/xs/tables/current/ModPerl/FunctionTable.pm Mon Feb 11
00:51:08 2008
@@ -5044,6 +5044,30 @@
'args' => []
},
{
+ 'return_type' => 'modperl_interp_t *',
+ 'name' => 'modperl_thx_interp_get',
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'thx',
+ },
+ ],
+ },
+ {
+ 'return_type' => 'void',
+ 'name' => 'modperl_thx_interp_set',
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'thx',
+ },
+ {
+ 'type' => 'modperl_interp_t *',
+ 'name' => 'interp',
+ },
+ ],
+ },
+ {
'return_type' => 'void',
'name' => 'modperl_tipool_add',
'args' => [
