Introduced thr->threadsvp and THREADSV() for faster per-thread

variables. Moved threadnum to a per-interpreter variable and
made dTHR and lock/unlock of sv_mutex bypass the get/lock unless
more than one thread may be running. Minor tweaks to Thread.xs.

p4raw-id: //depot/perl@453

diff --git a/dosish.h b/dosish.h
index 184d3df..9abbc5e 100644 (file)
--- a/dosish.h
+++ b/dosish.h
@@ -28,7 +28,6 @@
        } STMT_END
 #    define pthread_mutexattr_default NULL
 #    define pthread_condattr_default NULL
-#    define pthread_attr_default NULL
 #    define pthread_addr_t any_t
 #  endif
 #else  /* DJGPP */

diff --git a/embedvar.h b/embedvar.h
index f2f7f69..d11686c 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -189,6 +189,7 @@
 #define sv_objcount            (curinterp->Isv_objcount)
 #define sv_root                        (curinterp->Isv_root)
 #define tainting               (curinterp->Itainting)
+#define threadnum              (curinterp->Ithreadnum)
 #define thrsv                  (curinterp->Ithrsv)
 #define unsafe                 (curinterp->Iunsafe)
 #define warnhook               (curinterp->Iwarnhook)
@@ -306,6 +307,7 @@
 #define Isv_objcount           sv_objcount
 #define Isv_root               sv_root
 #define Itainting              tainting
+#define Ithreadnum             threadnum
 #define Ithrsv                 thrsv
 #define Iunsafe                        unsafe
 #define Iwarnhook              warnhook
@@ -483,6 +485,7 @@
 #define sv_objcount            Perl_sv_objcount
 #define sv_root                        Perl_sv_root
 #define tainting               Perl_tainting
+#define threadnum              Perl_threadnum
 #define thrsv                  Perl_thrsv
 #define unsafe                 Perl_unsafe
 #define warnhook               Perl_warnhook

diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs
index c5adcb3..3b49dbe 100644 (file)
--- a/ext/Thread/Thread.xs
+++ b/ext/Thread/Thread.xs
@@ -12,7 +12,6 @@
 #endif
 #include <fcntl.h>
                         
-static U32 threadnum = 0;
 static int sig_pipe[2];
             
 #ifndef THREAD_RET_TYPE
@@ -208,6 +207,8 @@ newthread (SV *startsv, AV *initargs, char *classname)
     SV *sv;
     int err;
 #ifndef THREAD_CREATE
+    static pthread_attr_t attr;
+    static int attr_inited = 0;
     sigset_t fullmask, oldmask;
 #endif
     
@@ -233,33 +234,22 @@ newthread (SV *startsv, AV *initargs, char *classname)
     sigfillset(&fullmask);
     if (sigprocmask(SIG_SETMASK, &fullmask, &oldmask) == -1)
        croak("panic: sigprocmask");
-#ifdef PTHREADS_CREATED_JOINABLE
-    err = pthread_create(&thr->self, pthread_attr_default,
-                        threadstart, (void*) thr);
-#else
-    {
-       pthread_attr_t attr;
-
+    err = 0;
+    if (!attr_inited) {
+       attr_inited = 1;
        err = pthread_attr_init(&attr);
-       if (err == 0) {
-#ifdef PTHREAD_CREATE_UNDETACHED
-         err = pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_UNDETACHED);
-#else
-         croak("panic: pthread_attr_setdetachstate");
-#endif
-         if (err == 0) 
-           err = pthread_create(&thr->self, &attr,
-                                threadstart, (void*) thr);
-       }
-       pthread_attr_destroy(&attr);
+       if (err == 0)
+           err = pthread_attr_setdetachstate(&attr, ATTR_JOINABLE);
     }
-#endif
+    if (err == 0)
+       err = pthread_create(&thr->self, &attr, threadstart, (void*) thr);
     /* Go */
     MUTEX_UNLOCK(&thr->mutex);
 #endif
     if (err) {
         DEBUG_L(PerlIO_printf(PerlIO_stderr(),
-                         "%p: create of %p failed %d\n", savethread, thr, err));
+                             "%p: create of %p failed %d\n",
+                             savethread, thr, err));
        /* Thread creation failed--clean up */
        SvREFCNT_dec(thr->cvcache);
        remove_thread(thr);

diff --git a/interp.sym b/interp.sym
index e95a916..5453afa 100644 (file)
--- a/interp.sym
+++ b/interp.sym
@@ -134,6 +134,7 @@ sv_root
 sv_arenaroot
 tainted
 tainting
+threadnum
 thrsv
 tmps_floor
 tmps_ix

diff --git a/intrpvar.h b/intrpvar.h
index f3014cb..be081be 100644 (file)
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -156,4 +156,5 @@ PERLVAR(Iofmt,              char *)         /* $# */
 
 #ifdef USE_THREADS
 PERLVAR(Ithrsv,                SV *)           /* holds struct perl_thread for main thread */
+PERLVARI(Ithreadnum,   U32,    0)      /* incremented each thread creation */
 #endif /* USE_THREADS */

diff --git a/op.c b/op.c
index 47f2f57..af0445c 100644 (file)
--- a/op.c
+++ b/op.c
@@ -514,6 +514,7 @@ find_threadsv(char *name)
     if (!svp) {
        SV *sv = NEWSV(0, 0);
        av_store(thr->threadsv, key, sv);
+       thr->threadsvp = AvARRAY(thr->threadsv);
        /*
         * Some magic variables used to be automagically initialised
         * in gv_fetchpv. Those which are now per-thread magicals get

diff --git a/perl.c b/perl.c
index c0fa69f..f18c3b0 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -936,7 +936,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
     SvREFCNT_dec(rs);
     rs = SvREFCNT_inc(nrs);
 #ifdef USE_THREADS
-    sv_setsv(*av_fetch(thr->threadsv, find_threadsv("/"), FALSE), rs); 
+    sv_setsv(THREADSV(find_threadsv("/")), rs); 
 #else
     sv_setsv(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), rs);
 #endif /* USE_THREADS */
@@ -1054,7 +1054,7 @@ perl_get_sv(char *name, I32 create)
        PADOFFSET tmp = find_threadsv(name);
        if (tmp != NOT_IN_PAD) {
            dTHR;
-           return *av_fetch(thr->threadsv, tmp, FALSE);
+           return THREADSV(tmp);
        }
     }
 #endif /* USE_THREADS */
@@ -2510,7 +2510,7 @@ init_predump_symbols(void)
     GV *othergv;
 
 #ifdef USE_THREADS
-    sv_setpvn(*av_fetch(thr->threadsv,find_threadsv("\""),FALSE)," ", 1);
+    sv_setpvn(THREADSV(find_threadsv("\"")), " ", 1);
 #else
     sv_setpvn(GvSV(gv_fetchpv("\"", TRUE, SVt_PV)), " ", 1);
 #endif /* USE_THREADS */
@@ -2799,6 +2799,7 @@ init_main_thread()
     curcop = &compiling;
     thr->cvcache = newHV();
     thr->threadsv = newAV();
+    /* thr->threadsvp is set when find_threadsv is called */
     thr->specific = newAV();
     thr->errhv = newHV();
     thr->flags = THRf_R_JOINABLE;

diff --git a/perl.h b/perl.h
index bec110c..820a6d2 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -471,8 +471,8 @@ Free_t   Perl_free _((Malloc_t where));
 #ifdef USE_THREADS
 #  define ERRSV (thr->errsv)
 #  define ERRHV (thr->errhv)
-#  define DEFSV *av_fetch(thr->threadsv, find_threadsv("_"), FALSE)
-#  define SAVE_DEFSV save_threadsv(find_threadsv("_"))
+#  define DEFSV THREADSV(0)
+#  define SAVE_DEFSV save_threadsv(0)
 #else
 #  define ERRSV GvSV(errgv)
 #  define ERRHV GvHV(errgv)
@@ -1379,6 +1379,7 @@ int runops_standard _((void));
 int runops_debug _((void));
 #endif
 
+/* _ (for $_) must be first in the following list (DEFSV requires it) */
 #define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@"
 
 /* VMS doesn't use environ array and NeXT has problems with crt0.o globals */
@@ -2035,12 +2036,12 @@ enum {
  * and queried under the protection of sv_mutex
  */
 #define offer_nice_chunk(chunk, chunk_size) do {       \
-       MUTEX_LOCK(&sv_mutex);                          \
+       LOCK_SV_MUTEX;                                  \
        if (!nice_chunk) {                              \
            nice_chunk = (char*)(chunk);                \
            nice_chunk_size = (chunk_size);             \
        }                                               \
-       MUTEX_UNLOCK(&sv_mutex);                        \
+       UNLOCK_SV_MUTEX;                                \
     } while (0)
 
 

diff --git a/pp.c b/pp.c
index 7864089..765f10b 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -4314,7 +4314,7 @@ PP(pp_threadsv)
     if (op->op_private & OPpLVAL_INTRO)
        PUSHs(*save_threadsv(op->op_targ));
     else
-       PUSHs(*av_fetch(thr->threadsv, op->op_targ, FALSE));
+       PUSHs(THREADSV(op->op_targ));
     RETURN;
 #else
     DIE("tried to access per-thread data in non-threaded perl");

diff --git a/pp_ctl.c b/pp_ctl.c
index 8226274..ae24601 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -547,7 +547,7 @@ PP(pp_grepstart)
     SAVETMPS;
 #ifdef USE_THREADS
     /* SAVE_DEFSV does *not* suffice here */
-    save_sptr(av_fetch(thr->threadsv, find_threadsv("_"), FALSE));
+    save_sptr(&THREADSV(0));
 #else
     SAVESPTR(GvSV(defgv));
 #endif /* USE_THREADS */

diff --git a/scope.c b/scope.c
index 3b4428f..038b391 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -335,7 +335,7 @@ save_threadsv(PADOFFSET i)
 {
 #ifdef USE_THREADS
     dTHR;
-    SV **svp = av_fetch(thr->threadsv, i, FALSE);
+    SV **svp = &THREADSV(i);   /* XXX Change to save by offset */
     DEBUG_L(PerlIO_printf(PerlIO_stderr(), "save_threadsv %u: %p %p:%s\n",
                          i, svp, *svp, SvPEEK(*svp)));
     save_svref(svp);

diff --git a/sv.c b/sv.c
index d6c1039..2ed06cd 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -65,18 +65,18 @@ typedef void (*SVFUNC) _((SV*));
 
 #define new_SV(p)                      \
     do {                               \
-       MUTEX_LOCK(&sv_mutex);          \
+       LOCK_SV_MUTEX;                  \
        (p) = (SV*)safemalloc(sizeof(SV)); \
        reg_add(p);                     \
-       MUTEX_UNLOCK(&sv_mutex);        \
+       UNLOCK_SV_MUTEX;                \
     } while (0)
 
 #define del_SV(p)                      \
     do {                               \
-       MUTEX_LOCK(&sv_mutex);          \
+       LOCK_SV_MUTEX;                  \
        reg_remove(p);                  \
         free((char*)(p));              \
-       MUTEX_UNLOCK(&sv_mutex);        \
+       UNLOCK_SV_MUTEX;                \
     } while (0)
 
 static SV **registry;
@@ -183,24 +183,24 @@ U32 flags;
        ++sv_count;                     \
     } while (0)
 
-#define new_SV(p)      do {            \
-       MUTEX_LOCK(&sv_mutex);          \
-       if (sv_root)                    \
-           uproot_SV(p);               \
-       else                            \
-           (p) = more_sv();            \
-       MUTEX_UNLOCK(&sv_mutex);        \
+#define new_SV(p)      do {    \
+       LOCK_SV_MUTEX;          \
+       if (sv_root)            \
+           uproot_SV(p);       \
+       else                    \
+           (p) = more_sv();    \
+       UNLOCK_SV_MUTEX;        \
     } while (0)
 
 #ifdef DEBUGGING
 
-#define del_SV(p)      do {            \
-       MUTEX_LOCK(&sv_mutex);          \
-       if (debug & 32768)              \
-           del_sv(p);                  \
-       else                            \
-           plant_SV(p);                \
-       MUTEX_UNLOCK(&sv_mutex);        \
+#define del_SV(p)      do {    \
+       LOCK_SV_MUTEX;          \
+       if (debug & 32768)      \
+           del_sv(p);          \
+       else                    \
+           plant_SV(p);        \
+       UNLOCK_SV_MUTEX;        \
     } while (0)
 
 static void

diff --git a/thrdvar.h b/thrdvar.h
index 33419de..9719420 100644 (file)
--- a/thrdvar.h
+++ b/thrdvar.h
@@ -87,6 +87,7 @@ PERLVAR(cvcache,      HV *)
 PERLVAR(self,          perl_os_thread)         /* Underlying thread object */
 PERLVAR(flags,         U32)            
 PERLVAR(threadsv,      AV *)                   /* Per-thread SVs ($_, $@ etc.) */
+PERLVAR(threadsvp,     SV **)                  /* AvARRAY(threadsv) */
 PERLVAR(specific,      AV *)                   /* Thread-specific user data */
 PERLVAR(errsv,         SV *)                   /* Backing SV for $@ */
 PERLVAR(errhv,         HV *)                   /* HV for what was %@ in pp_ctl.c */

diff --git a/thread.h b/thread.h
index 2328f7e..1b1ddf9 100644 (file)
--- a/thread.h
+++ b/thread.h
@@ -20,10 +20,19 @@
 #else
 #  define pthread_mutexattr_default NULL
 #  define pthread_condattr_default NULL
-#  define pthread_attr_default NULL
 #endif /* OLD_PTHREADS_API */
 #endif
 
+#ifdef PTHREADS_CREATED_JOINABLE
+#  define ATTR_JOINABLE PTHREAD_CREATE_JOINABLE
+#else
+#  ifdef PTHREAD_CREATE_UNDETACHED
+#    define ATTR_JOINABLE PTHREAD_CREATE_UNDETACHED
+#  else
+#    define ATTR_JOINABLE PTHREAD_CREATE_JOINABLE
+#  endif
+#endif
+
 #ifndef YIELD
 #  ifdef HAS_PTHREAD_YIELD
 #    define YIELD pthread_yield()
@@ -119,8 +128,16 @@ struct perl_thread *getTHR _((void));
 #  endif /* OLD_PTHREADS_API */
 #endif /* THR */
 
+/*
+ * dTHR is performance-critical. Here, we only do the pthread_get_specific
+ * if there may be more than one thread in existence, otherwise we get thr
+ * from thrsv which is cached in the per-interpreter structure.
+ * Systems with very fast pthread_get_specific (which should be all systems
+ * but unfortunately isn't) may wish to simplify to "...*thr = THR".
+ */
 #ifndef dTHR
-#  define dTHR struct perl_thread *thr = THR
+#  define dTHR \
+    struct perl_thread *thr = threadnum? THR : (struct perl_thread*)SvPVX(thrsv)
 #endif /* dTHR */
 
 #ifndef INIT_THREADS
@@ -131,6 +148,26 @@ struct perl_thread *getTHR _((void));
 #  endif
 #endif
 
+/* Accessor for per-thread SVs */
+#define THREADSV(i) (thr->threadsvp[i])
+
+/*
+ * LOCK_SV_MUTEX and UNLOCK_SV_MUTEX are performance-critical. Here, we
+ * try only locking them if there may be more than one thread in existence.
+ * Systems with very fast mutexes (and/or slow conditionals) may wish to
+ * remove the "if (threadnum) ..." test.
+ */
+#define LOCK_SV_MUTEX                  \
+    STMT_START {                       \
+       if (threadnum)                  \
+           MUTEX_LOCK(&sv_mutex);      \
+    } STMT_END
+
+#define UNLOCK_SV_MUTEX                        \
+    STMT_START {                       \
+       if (threadnum)                  \
+           MUTEX_UNLOCK(&sv_mutex);    \
+    } STMT_END
 
 #ifndef THREAD_RET_TYPE
 #  define THREAD_RET_TYPE      void *

diff --git a/util.c b/util.c
index 1c4b79a..bb82ad0 100644 (file)
--- a/util.c
+++ b/util.c
@@ -56,10 +56,6 @@
 static void xstat _((void));
 #endif
 
-#ifdef USE_THREADS
-static U32 threadnum = 0;
-#endif /* USE_THREADS */
-
 #ifndef MYMALLOC
 
 /* paranoid version of malloc */
@@ -2443,11 +2439,11 @@ condpair_magic(SV *sv)
        COND_INIT(&cp->owner_cond);
        COND_INIT(&cp->cond);
        cp->owner = 0;
-       MUTEX_LOCK(&sv_mutex);
+       LOCK_SV_MUTEX;
        mg = mg_find(sv, 'm');
        if (mg) {
            /* someone else beat us to initialising it */
-           MUTEX_UNLOCK(&sv_mutex);
+           UNLOCK_SV_MUTEX;
            MUTEX_DESTROY(&cp->mutex);
            COND_DESTROY(&cp->owner_cond);
            COND_DESTROY(&cp->cond);
@@ -2458,7 +2454,7 @@ condpair_magic(SV *sv)
            mg = SvMAGIC(sv);
            mg->mg_ptr = (char *)cp;
            mg->mg_len = sizeof(cp);
-           MUTEX_UNLOCK(&sv_mutex);
+           UNLOCK_SV_MUTEX;
            DEBUG_L(WITH_THR(PerlIO_printf(PerlIO_stderr(),
                                           "%p: condpair_magic %p\n", thr, sv));)
        }
@@ -2552,6 +2548,7 @@ new_struct_thread(struct perl_thread *t)
                "new_struct_thread: copied threadsv %d %p->%p\n",i, t, thr));
        }
     } 
+    thr->threadsvp = AvARRAY(thr->threadsv);
 
     MUTEX_LOCK(&threads_mutex);
     nthreads++;