Merged revision(s) 1243554, 1243647, 1243679, 1245916, 1291304 from perl/modperl/branches/threading:

Steve Hay · Steve Hay · commit 49b3b07dab3a · 2013-11-01T00:33:25.000Z
move interp allocation out of modperl_hash_handlers*() These functions are called in a loop (modperl_mgv_hash_handlers()). Now, the interp is allocated outside the loop. ........ drop unused MP_dTHX and MP_uTHX macros ........ eliminate MP_dSCFG_dTHX ........ suppress "perl=..." output in MP_TRACE output before the first interpreter has been started ........ fix missing base_scfg declaration in modperl_init() if USE_ITHREADS && !MP_TRACE ........ git-svn-id: https://svn.apache.org/repos/asf/perl/modperl/branches/httpd24threading@1537779 13f79535-47bb-0310-9956-ffa450edef68
diff --git a/src/modules/perl/mod_perl.c b/src/modules/perl/mod_perl.c
@@ -216,8 +216,10 @@ PerlInterpreter *modperl_startup(server_rec *s, apr_pool_t *p)
         server_rec *base_server = modperl_global_get_server_rec();
         const char *desc = modperl_server_desc(s, p);
         if (base_server == s) {
+            MP_init_status = 1; /* temporarily reset MP_init_status */
             MP_TRACE_i(MP_FUNC,
                        "starting the parent perl for the base server", desc);
+            MP_init_status = 2;
         }
         else {
             MP_TRACE_i(MP_FUNC,
@@ -441,12 +443,12 @@ void modperl_init(server_rec *base_server, apr_pool_t *p)
 {
     server_rec *s;
     PerlInterpreter *base_perl;
-#ifdef MP_TRACE
+#if defined(MP_TRACE) || defined(USE_ITHREADS)
     modperl_config_srv_t *base_scfg = modperl_config_srv_get(base_server);
+#endif
 
     MP_TRACE_d_do(MpSrv_dump_flags(base_scfg,
                                    base_server->server_hostname));
-#endif /* MP_TRACE */
 
 #ifndef USE_ITHREADS
     if (modperl_threaded_mpm()) {
diff --git a/src/modules/perl/modperl_common_log.c b/src/modules/perl/modperl_common_log.c
@@ -52,21 +52,27 @@ void modperl_trace(const char *func, const char *fmt, ...)
     /* for more information on formatting codes see
        http://apr.apache.org/docs/apr/1.4/group__apr__lib.html#gad2cd3594aeaafd45931d1034965f48c1
      */
+
+    /* PERL_GET_CONTEXT yields nonsense until the first interpreter is
+     * created. Hence the modperl_is_running() question. */
     if (modperl_threaded_mpm()) {
         if (modperl_threads_started()) {
             apr_file_printf(logfile, "[pid=%lu, tid=%pt, perl=%pp] ",
                             (unsigned long)getpid(),
-                            (void*)apr_os_thread_current(), PERL_GET_CONTEXT);
+                            (void*)apr_os_thread_current(),
+                            modperl_is_running() ? PERL_GET_CONTEXT : NULL);
         }
         else {
             apr_file_printf(logfile, "[pid=%lu, perl=%pp] ",
-                            (unsigned long)getpid(), PERL_GET_CONTEXT);
+                            (unsigned long)getpid(),
+                            modperl_is_running() ? PERL_GET_CONTEXT : NULL);
         }
     }
     else {
 #ifdef USE_ITHREADS
         apr_file_printf(logfile, "[pid=%lu, perl=%pp] ",
-                        (unsigned long)getpid(), PERL_GET_CONTEXT);
+                        (unsigned long)getpid(),
+                        modperl_is_running() ? PERL_GET_CONTEXT : NULL);
 #else
         apr_file_printf(logfile, "[pid=%lu] ", (unsigned long)getpid());
 #endif
diff --git a/src/modules/perl/modperl_config.h b/src/modules/perl/modperl_config.h
@@ -118,26 +118,6 @@ void modperl_set_perl_module_config(ap_conf_vector_t *cv, void *cfg);
 #define MP_dSCFG(s)                                             \
     modperl_config_srv_t *scfg = modperl_config_srv_get(s)
 
-#ifdef USE_ITHREADS
-#   define MP_dSCFG_dTHX            \
-    dTHXa(scfg->mip->parent->perl); \
-    PERL_SET_CONTEXT(aTHX)
-#else
-#   define MP_dSCFG_dTHX dTHXa(scfg->perl)
-#endif
-
-/* hopefully this macro will not need to be used often */
-#ifdef USE_ITHREADS
-#   define MP_dTHX                                              \
-    modperl_interp_t *interp =                                  \
-        modperl_interp_select(r, r->connection, r->server);     \
-    dTHXa(interp->perl)
-#   define MP_uTHX modperl_interp_unselect(interp)
-#else
-#   define MP_dTHX dNOOP
-#   define MP_uTHX dNOOP
-#endif
-
 int modperl_config_apply_PerlModule(server_rec *s,
                                     modperl_config_srv_t *scfg,
                                     PerlInterpreter *perl, apr_pool_t *p);
diff --git a/src/modules/perl/modperl_handler.c b/src/modules/perl/modperl_handler.c
@@ -345,9 +345,15 @@ void modperl_handler_make_args(pTHX_ AV **avp, ...)
 #define set_desc(dtype)                                 \
     if (desc) *desc = modperl_handler_desc_##dtype(idx)
 
+/* We should be able to use PERL_GET_CONTEXT here. The rcfg condition
+ * makes sure there is a request being processed. The action > GET part
+ * means it is a $r->set_handlers or $r->push_handlers operation. This
+ * can only happen if called by perl code.
+ */
 #define check_modify(dtype)                                     \
     if ((action > MP_HANDLER_ACTION_GET) && rcfg) {             \
-        MP_dSCFG_dTHX;                                          \
+        dTHXa(PERL_GET_CONTEXT);                                \
+        MP_ASSERT(aTHX+0);                                      \
         Perl_croak(aTHX_ "too late to modify %s handlers",      \
                    modperl_handler_desc_##dtype(idx));          \
     }
diff --git a/src/modules/perl/modperl_mgv.c b/src/modules/perl/modperl_mgv.c
@@ -476,10 +476,7 @@ static int modperl_hash_handlers_dir(apr_pool_t *p, server_rec *s,
 {
     int i;
     modperl_config_dir_t *dir_cfg = (modperl_config_dir_t *)cfg;
-#ifdef USE_ITHREADS
-    MP_dSCFG(s);
-    MP_dSCFG_dTHX;
-#endif
+    dTHXa(data);
 
     if (!dir_cfg) {
         return 1;
@@ -497,7 +494,7 @@ static int modperl_hash_handlers_srv(apr_pool_t *p, server_rec *s,
 {
     int i;
     modperl_config_srv_t *scfg = (modperl_config_srv_t *)cfg;
-    MP_dSCFG_dTHX;
+    dTHXa(data);
 
     for (i=0; i < MP_HANDLER_NUM_PER_SRV; i++) {
         modperl_hash_handlers(aTHX_ p, s,
@@ -524,9 +521,16 @@ static int modperl_hash_handlers_srv(apr_pool_t *p, server_rec *s,
 
 void modperl_mgv_hash_handlers(apr_pool_t *p, server_rec *s)
 {
-    ap_pcw_walk_config(p, s, &perl_module, NULL,
+    MP_dINTERPa(NULL, NULL, s);
+    ap_pcw_walk_config(p, s, &perl_module,
+#ifdef USE_ITHREADS
+                       aTHX,
+#else
+                       NULL,
+#endif
                        modperl_hash_handlers_dir,
                        modperl_hash_handlers_srv);
+    MP_INTERP_PUTBACK(interp, aTHX);
 }
 
 /*
