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

15 files changed, 91 insertions, 59 deletions

diff --git a/dosish.h b/dosish.h
index 184d3dfb45..9abbc5ebbf 100644
--- 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 f2f7f690c7..d11686ca34 100644
--- 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 c5adcb3eb7..3b49dbecb2 100644
--- 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 e95a9162c4..5453afa064 100644
--- 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 f3014cbb14..be081be3d5 100644
--- 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 47f2f57f3e..af0445cac8 100644
--- 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 c0fa69f021..f18c3b0b53 100644
--- 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 bec110cf74..820a6d2aed 100644
--- 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 7864089313..765f10b702 100644
--- 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 822627414d..ae24601658 100644
--- 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 3b4428f945..038b3912cf 100644
--- 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 d6c10391e3..2ed06cd672 100644
--- 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 33419dea4e..9719420d96 100644
--- 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 2328f7ed82..1b1ddf98be 100644
--- 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 1c4b79af7f..bb82ad035e 100644
--- 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++;