[win32] integrate mainline

p4raw-id: //depot/win32/perl@455

18 files changed, 114 insertions, 68 deletions

diff --git a/MANIFEST b/MANIFEST
index e1a7c55ed1..a9094bb942 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -551,12 +551,18 @@ patchlevel.h		The current patch level of perl
 perl.c			main()
 perl.h			Global declarations
 perl_exp.SH		Creates list of exported symbols for AIX
+perldir.h		perldir stuff
+perlenv.h		perlenv stuff
 perlio.c		C code for PerlIO abstraction
 perlio.h		Interface to PerlIO abstraction
 perlio.sym		Symbols for PerlIO abstraction
+perllio.h		perllio stuff
+perlmem.h		perlmem stuff
+perlproc.h		perlproc stuff
 perlsdio.h		Fake stdio using perlio
 perlsfio.h		Prototype sfio mapping for PerlIO
 perlsh			A poor man's perl shell
+perlsock.h		perlsock stuff
 perlvars.h		Global variables
 perly.c			A byacc'ed perly.y
 perly.c.diff		Fixup perly.c to allow recursion
@@ -605,7 +611,7 @@ pod/perlfaq9.pod	Frequently Asked Questions, Part 9
 pod/perlform.pod	Format info
 pod/perlfunc.pod	Function info
 pod/perlguts.pod	Internals info
-pod/perlhist.pod	The Perl history records
+pod/perlhist.pod	Perl history info
 pod/perlipc.pod		IPC info
 pod/perllocale.pod	Locale support info
 pod/perllol.pod		How to use lists of lists
@@ -741,6 +747,9 @@ t/lib/tie-push.t	Test for Tie::Array
 t/lib/tie-stdarray.t	Test for Tie::StdArray
 t/lib/tie-stdpush.t	Test for Tie::StdArray
 t/lib/thread.t		Basic test of threading (skipped if no threads) 
+t/lib/tie-push.t	See if pushing onto tied arrays works
+t/lib/tie-stdarray.t	See if tied arrays work
+t/lib/tie-stdpush.t	See if pushing onto standard tied arrays works
 t/lib/trig.t		See if Math::Trig works
 t/op/append.t		See if . works
 t/op/arith.t		See if arithmetic works
@@ -804,7 +813,7 @@ t/op/substr.t		See if substr works
 t/op/sysio.t		See if sysread and syswrite work
 t/op/taint.t		See if tainting works
 t/op/tie.t		See if tie/untie functions work
-t/op/tiearray.t		See if tied arrays work
+t/op/tiearray.t		See if tie for arrays works
 t/op/time.t		See if time functions work
 t/op/undef.t		See if undef works
 t/op/universal.t	See if UNIVERSAL class works
@@ -876,7 +885,7 @@ win32/Makefile		Win32 makefile for NMAKE (Visual C++ build)
 win32/TEST		Win32 port
 win32/autosplit.pl	Win32 port
 win32/bin/network.pl	Win32 port
-win32/bin/perlglob.pl	glob() support
+win32/bin/perlglob.pl	Win32 globbing
 win32/bin/pl2bat.pl	wrap perl scripts into batch files
 win32/bin/runperl.pl	run perl script via batch file namesake
 win32/bin/search.pl	Win32 port
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/hints/dec_osf.sh b/hints/dec_osf.sh
index a1efc11cd1..2e8ffac5bd 100644
--- a/hints/dec_osf.sh
+++ b/hints/dec_osf.sh
@@ -121,8 +121,11 @@ esac
 # no attempt to figure out the additional location(s) searched by
 # gcc, since not all versions of gcc are easily coerced into
 # revealing that information.
-glibpth="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc"
-glibpth="$glibpth /usr/lib /usr/local/lib /var/shlib"
+#
+# This or the new useshrplib default below breaks the build.
+# Commented out for this snapshot.
+#glibpth="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc"
+#glibpth="$glibpth /usr/lib /usr/local/lib /var/shlib"
 
 # dlopen() is in libc
 libswanted="`echo $libswanted | sed -e 's/ dl / /'`"
@@ -196,9 +199,11 @@ fi
 # "-Uuseshrplib" prevents this default.
 #
 
-case "$_DEC_cc_style.$useshrplib" in
-	new.)	useshrplib="$define"	;;
-esac
+# This or the glibpth change above breaks the build. Commented out
+# for this snapshot.
+#case "$_DEC_cc_style.$useshrplib" in
+#	new.)	useshrplib="$define"	;;
+#esac
 
 #
 # Unset temporary variables no more needed.
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 073569c1e4..88d647518b 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/patchlevel.h b/patchlevel.h
index 4831469ad7..e5cbc07622 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1,5 +1,5 @@
 #define PATCHLEVEL 4
-#define SUBVERSION 56
+#define SUBVERSION 57
 
 /*
 	local_patches -- list of locally applied less-than-subversion patches.
diff --git a/perl.c b/perl.c
index 60d4d7d7df..54fb772d4e 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 9b1fb5e600..9b521b9d3c 100644
--- a/perl.h
+++ b/perl.h
@@ -476,8 +476,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)
@@ -1384,6 +1384,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 */
@@ -2040,12 +2041,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 3f4b8bc1c4..79d884d115 100644
--- a/pp.c
+++ b/pp.c
@@ -4392,7 +4392,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 68bf5d2beb..d0033bfd99 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 61bc731457..350ed304f0 100644
--- a/scope.c
+++ b/scope.c
@@ -346,7 +346,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 cd756a0a4c..5b37d72df5 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);			\
         Safefree((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 31827b0f7f..dc0f4405d5 100644
--- a/util.c
+++ b/util.c
@@ -57,10 +57,6 @@
 static void xstat _((void));
 #endif
 
-#ifdef USE_THREADS
-static U32 threadnum = 0;
-#endif /* USE_THREADS */
-
 #ifndef MYMALLOC
 
 /* paranoid version of malloc */
@@ -2444,11 +2440,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);
@@ -2459,7 +2455,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));)
 	}
@@ -2553,6 +2549,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++;