Win32 patches for cfgperl from Sarathy.

p4raw-id: //depot/cfgperl@6307

19 files changed, 96 insertions, 71 deletions

diff --git a/doio.c b/doio.c
index 6f62144c4e..d253f9813b 100644
--- a/doio.c
+++ b/doio.c
@@ -476,13 +476,13 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	    SV *sv;
 
 	    PerlLIO_dup2(PerlIO_fileno(fp), fd);
-	    MUTEX_LOCK(&PL_fdpid_mutex);
+	    LOCK_FDPID_MUTEX;
 	    sv = *av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE);
 	    (void)SvUPGRADE(sv, SVt_IV);
 	    pid = SvIVX(sv);
 	    SvIVX(sv) = 0;
 	    sv = *av_fetch(PL_fdpid,fd,TRUE);
-	    MUTEX_UNLOCK(&PL_fdpid_mutex);
+	    UNLOCK_FDPID_MUTEX;
 	    (void)SvUPGRADE(sv, SVt_IV);
 	    SvIVX(sv) = pid;
 	    if (!was_fdopen)
diff --git a/doop.c b/doop.c
index 3394db2dc6..0c6e690528 100644
--- a/doop.c
+++ b/doop.c
@@ -23,11 +23,11 @@
 
 
 #define HALF_UPGRADE(start,end) {                                    \
-                                U8* new;                             \
+                                U8* newstr;                          \
                                 STRLEN len;                          \
                                 len = end-start;                     \
-                                new = bytes_to_utf8(start, &len);    \
-                                Copy(new,start,len,U8*);             \
+                                newstr = bytes_to_utf8(start, &len); \
+                                Copy(newstr,start,len,U8*);          \
                                 end = start + len;                   \
                                 }
 
diff --git a/embed.h b/embed.h
index 6fc37214e0..928be1943e 100644
--- a/embed.h
+++ b/embed.h
@@ -765,6 +765,9 @@
 #endif
 #define runops_standard		Perl_runops_standard
 #define runops_debug		Perl_runops_debug
+#if defined(USE_THREADS)
+#define sv_lock			Perl_sv_lock
+#endif
 #define sv_catpvf_mg		Perl_sv_catpvf_mg
 #define sv_vcatpvf_mg		Perl_sv_vcatpvf_mg
 #define sv_catpv_mg		Perl_sv_catpv_mg
@@ -1132,7 +1135,6 @@
 #define xstat			S_xstat
 #  endif
 #endif
-#define lock			Perl_lock
 #if defined(PERL_OBJECT)
 #endif
 #define ck_anoncode		Perl_ck_anoncode
@@ -2215,6 +2217,9 @@
 #endif
 #define runops_standard()	Perl_runops_standard(aTHX)
 #define runops_debug()		Perl_runops_debug(aTHX)
+#if defined(USE_THREADS)
+#define sv_lock(a)		Perl_sv_lock(aTHX_ a)
+#endif
 #define sv_vcatpvf_mg(a,b,c)	Perl_sv_vcatpvf_mg(aTHX_ a,b,c)
 #define sv_catpv_mg(a,b)	Perl_sv_catpv_mg(aTHX_ a,b)
 #define sv_catpvn_mg(a,b,c)	Perl_sv_catpvn_mg(aTHX_ a,b,c)
@@ -2577,7 +2582,6 @@
 #define xstat(a)		S_xstat(aTHX_ a)
 #  endif
 #endif
-#define lock(a)			Perl_lock(aTHX_ a)
 #if defined(PERL_OBJECT)
 #endif
 #define ck_anoncode(a)		Perl_ck_anoncode(aTHX_ a)
@@ -4337,6 +4341,10 @@
 #define runops_standard		Perl_runops_standard
 #define Perl_runops_debug	CPerlObj::Perl_runops_debug
 #define runops_debug		Perl_runops_debug
+#if defined(USE_THREADS)
+#define Perl_sv_lock		CPerlObj::Perl_sv_lock
+#define sv_lock			Perl_sv_lock
+#endif
 #define Perl_sv_catpvf_mg	CPerlObj::Perl_sv_catpvf_mg
 #define sv_catpvf_mg		Perl_sv_catpvf_mg
 #define Perl_sv_vcatpvf_mg	CPerlObj::Perl_sv_vcatpvf_mg
@@ -5000,8 +5008,6 @@
 #define xstat			S_xstat
 #  endif
 #endif
-#define Perl_lock		CPerlObj::Perl_lock
-#define lock			Perl_lock
 #if defined(PERL_OBJECT)
 #endif
 #define Perl_ck_anoncode	CPerlObj::Perl_ck_anoncode
diff --git a/embed.pl b/embed.pl
index 7e94a09146..3d4f3bb76b 100755
--- a/embed.pl
+++ b/embed.pl
@@ -2106,6 +2106,9 @@ Ap	|struct perl_vars *|GetVars
 #endif
 Ap	|int	|runops_standard
 Ap	|int	|runops_debug
+#if defined(USE_THREADS)
+Ap	|SV*	|sv_lock	|SV *sv
+#endif
 Afpd	|void	|sv_catpvf_mg	|SV *sv|const char* pat|...
 Ap	|void	|sv_vcatpvf_mg	|SV* sv|const char* pat|va_list* args
 Apd	|void	|sv_catpv_mg	|SV *sv|const char *ptr
@@ -2515,8 +2518,6 @@ s	|void	|xstat		|int
 #  endif
 #endif
 
-Arp	|SV*	|lock		|SV *sv
-
 #if defined(PERL_OBJECT)
 };
 #endif
diff --git a/global.sym b/global.sym
index 9053446da2..719e50a2f4 100644
--- a/global.sym
+++ b/global.sym
@@ -480,6 +480,7 @@ Perl_safexfree
 Perl_GetVars
 Perl_runops_standard
 Perl_runops_debug
+Perl_sv_lock
 Perl_sv_catpvf_mg
 Perl_sv_vcatpvf_mg
 Perl_sv_catpv_mg
@@ -542,4 +543,3 @@ Perl_ptr_table_fetch
 Perl_ptr_table_store
 Perl_ptr_table_split
 Perl_sys_intern_clear
-Perl_sys_intern_init
diff --git a/gv.c b/gv.c
index e24fc45206..f18f174d6e 100644
--- a/gv.c
+++ b/gv.c
@@ -438,14 +438,14 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
     ENTER;
 
 #ifdef USE_THREADS
-    Perl_lock(aTHX_ (SV *)varstash);
+    sv_lock((SV *)varstash);
 #endif
     if (!isGV(vargv))
 	gv_init(vargv, varstash, autoload, autolen, FALSE);
     LEAVE;
     varsv = GvSV(vargv);
 #ifdef USE_THREADS
-    Perl_lock(aTHX_ varsv);
+    sv_lock(varsv);
 #endif
     sv_setpv(varsv, HvNAME(stash));
     sv_catpvn(varsv, "::", 2);
diff --git a/makedef.pl b/makedef.pl
index 108993c75d..a02a298213 100644
--- a/makedef.pl
+++ b/makedef.pl
@@ -421,7 +421,7 @@ unless ($define{'USE_5005THREADS'}) {
 		    Perl_find_threadsv
 		    Perl_unlock_condpair
 		    Perl_magic_mutexfree
-		    Perl_lock
+		    Perl_sv_lock
 		    )];
 }
 
diff --git a/objXSUB.h b/objXSUB.h
index 4f51cb81ec..0209fd3900 100644
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -1954,6 +1954,12 @@
 #define Perl_runops_debug	pPerl->Perl_runops_debug
 #undef  runops_debug
 #define runops_debug		Perl_runops_debug
+#if defined(USE_THREADS)
+#undef  Perl_sv_lock
+#define Perl_sv_lock		pPerl->Perl_sv_lock
+#undef  sv_lock
+#define sv_lock			Perl_sv_lock
+#endif
 #undef  Perl_sv_catpvf_mg
 #define Perl_sv_catpvf_mg	pPerl->Perl_sv_catpvf_mg
 #undef  sv_catpvf_mg
@@ -2277,10 +2283,6 @@
 #  if defined(LEAKTEST)
 #  endif
 #endif
-#undef  Perl_lock
-#define Perl_lock		pPerl->Perl_lock
-#undef  lock
-#define lock			Perl_lock
 #if defined(PERL_OBJECT)
 #endif
 
diff --git a/op.c b/op.c
index 97f8d29778..1469be97a1 100644
--- a/op.c
+++ b/op.c
@@ -6265,8 +6265,8 @@ S_method_2entersub(pTHX_ OP *o, OP *o2, OP *svop)
 
     if (o2->op_type == OP_CONST) {
         STRLEN len;
-        char *package = SvPV(((SVOP*)o2)->op_sv, len);
-        stash = gv_stashpvn(package, len, FALSE);
+        char *pkg = SvPV(((SVOP*)o2)->op_sv, len);
+        stash = gv_stashpvn(pkg, len, FALSE);
     }
     else if (o2->op_type == OP_PADSV) {
         /* my Dog $spot = shift; $spot->bark */
diff --git a/perlapi.c b/perlapi.c
index 26d559a0fd..6a54b94b22 100755
--- a/perlapi.c
+++ b/perlapi.c
@@ -3533,6 +3533,15 @@ Perl_runops_debug(pTHXo)
 {
     return ((CPerlObj*)pPerl)->Perl_runops_debug();
 }
+#if defined(USE_THREADS)
+
+#undef  Perl_sv_lock
+SV*
+Perl_sv_lock(pTHXo_ SV *sv)
+{
+    return ((CPerlObj*)pPerl)->Perl_sv_lock(sv);
+}
+#endif
 
 #undef  Perl_sv_catpvf_mg
 void
@@ -4060,13 +4069,6 @@ Perl_sys_intern_init(pTHXo)
 #  if defined(LEAKTEST)
 #  endif
 #endif
-
-#undef  Perl_lock
-SV*
-Perl_lock(pTHXo_ SV *sv)
-{
-    return ((CPerlObj*)pPerl)->Perl_lock(sv);
-}
 #if defined(PERL_OBJECT)
 #endif
 
diff --git a/pp.c b/pp.c
index efea0c1a94..1649cf4d2c 100644
--- a/pp.c
+++ b/pp.c
@@ -5263,7 +5263,7 @@ PP(pp_lock)
     dTOPss;
     SV *retsv = sv;
 #ifdef USE_THREADS
-    Perl_lock(aTHX_ sv);
+    sv_lock(sv);
 #endif /* USE_THREADS */
     if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV
 	|| SvTYPE(retsv) == SVt_PVCV) {
diff --git a/pp_ctl.c b/pp_ctl.c
index 94007601ed..a924d2ebe3 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -892,8 +892,8 @@ PP(pp_sort)
 		    PL_sortstash = stash;
 		}
 #ifdef USE_THREADS
-		Perl_lock(aTHX_ (SV *)PL_firstgv);
-		Perl_lock(aTHX_ (SV *)PL_secondgv);
+		sv_lock((SV *)PL_firstgv);
+		sv_lock((SV *)PL_secondgv);
 #endif
 		SAVESPTR(GvSV(PL_firstgv));
 		SAVESPTR(GvSV(PL_secondgv));
diff --git a/pp_hot.c b/pp_hot.c
index 8d35b7e4b1..ea2b9320fd 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -145,7 +145,7 @@ PP(pp_concat)
   {
     dPOPTOPssrl;
     STRLEN len;
-    U8 *s;
+    char *s;
     bool left_utf = DO_UTF8(left);
     bool right_utf = DO_UTF8(right);
 
@@ -156,7 +156,7 @@ PP(pp_concat)
         }
         else {
             /* Set TARG to PV(left), then add right */
-            U8 *l, *c;
+            char *l, *c;
             STRLEN targlen;
             if (TARG == right)
                 /* Need a safe copy elsewhere since we're just about to
@@ -182,7 +182,7 @@ PP(pp_concat)
             /* And now copy, maybe upgrading right to UTF8 on the fly */
             for (c = SvEND(TARG); *s; s++) {
                  if (*s & 0x80 && !right_utf)
-                     c = uv_to_utf8(c, *s);
+                     c = (char*)uv_to_utf8((U8*)c, *s);
                  else
                      *c++ = *s;
             }
diff --git a/proto.h b/proto.h
index e7a21c360f..bd222fe835 100644
--- a/proto.h
+++ b/proto.h
@@ -865,6 +865,9 @@ PERL_CALLCONV struct perl_vars *	Perl_GetVars(pTHX);
 #endif
 PERL_CALLCONV int	Perl_runops_standard(pTHX);
 PERL_CALLCONV int	Perl_runops_debug(pTHX);
+#if defined(USE_THREADS)
+PERL_CALLCONV SV*	Perl_sv_lock(pTHX_ SV *sv);
+#endif
 PERL_CALLCONV void	Perl_sv_catpvf_mg(pTHX_ SV *sv, const char* pat, ...)
 #ifdef CHECK_FORMAT
  __attribute__((format(printf,pTHX_2,pTHX_3)))
@@ -1267,8 +1270,6 @@ STATIC void	S_xstat(pTHX_ int);
 #  endif
 #endif
 
-PERL_CALLCONV SV*	Perl_lock(pTHX_ SV *sv) __attribute__((noreturn));
-
 #if defined(PERL_OBJECT)
 };
 #endif
diff --git a/thread.h b/thread.h
index 0ea9e74544..82343607c1 100644
--- a/thread.h
+++ b/thread.h
@@ -280,7 +280,8 @@
 #  define UNLOCK_STRTAB_MUTEX	MUTEX_UNLOCK(&PL_strtab_mutex)
 #  define LOCK_CRED_MUTEX	MUTEX_LOCK(&PL_cred_mutex)
 #  define UNLOCK_CRED_MUTEX	MUTEX_UNLOCK(&PL_cred_mutex)
-
+#  define LOCK_FDPID_MUTEX	MUTEX_LOCK(&PL_fdpid_mutex)
+#  define UNLOCK_FDPID_MUTEX	MUTEX_UNLOCK(&PL_fdpid_mutex)
 
 /* Values and macros for thr->flags */
 #define THRf_STATE_MASK	7
@@ -376,6 +377,14 @@ typedef struct condpair {
 #  define UNLOCK_CRED_MUTEX
 #endif
 
+#ifndef LOCK_FDPID_MUTEX
+#  define LOCK_FDPID_MUTEX
+#endif
+
+#ifndef UNLOCK_FDPID_MUTEX
+#  define UNLOCK_FDPID_MUTEX
+#endif
+
 /* THR, SET_THR, and dTHR are there for compatibility with old versions */
 #ifndef THR
 #  define THR		PERL_GET_THX
diff --git a/toke.c b/toke.c
index d6bb6d9291..fc51d910e1 100644
--- a/toke.c
+++ b/toke.c
@@ -7391,27 +7391,6 @@ Perl_yyerror(pTHX_ char *s)
 }
 
 
-#ifdef PERL_OBJECT
-#include "XSUB.h"
-#endif
-
-/*
- * restore_rsfp
- * Restore a source filter.
- */
-
-static void
-restore_rsfp(pTHXo_ void *f)
-{
-    PerlIO *fp = (PerlIO*)f;
-
-    if (PL_rsfp == PerlIO_stdin())
-	PerlIO_clearerr(PL_rsfp);
-    else if (PL_rsfp && (PL_rsfp != fp))
-	PerlIO_close(PL_rsfp);
-    PL_rsfp = fp;
-}
-
 STATIC char*
 S_swallow_bom(pTHX_ char *s) {
     STRLEN slen;
@@ -7463,3 +7442,24 @@ S_swallow_bom(pTHX_ char *s) {
 } 
 return s;
 }
+
+#ifdef PERL_OBJECT
+#include "XSUB.h"
+#endif
+
+/*
+ * restore_rsfp
+ * Restore a source filter.
+ */
+
+static void
+restore_rsfp(pTHXo_ void *f)
+{
+    PerlIO *fp = (PerlIO*)f;
+
+    if (PL_rsfp == PerlIO_stdin())
+	PerlIO_clearerr(PL_rsfp);
+    else if (PL_rsfp && (PL_rsfp != fp))
+	PerlIO_close(PL_rsfp);
+    PL_rsfp = fp;
+}
diff --git a/util.c b/util.c
index e0f1f14a90..d892e75120 100644
--- a/util.c
+++ b/util.c
@@ -2402,9 +2402,9 @@ Perl_my_popen(pTHX_ char *cmd, char *mode)
 	PerlLIO_close(p[This]);
 	p[This] = p[that];
     }
-    MUTEX_LOCK(&PL_fdpid_mutex);
+    LOCK_FDPID_MUTEX;
     sv = *av_fetch(PL_fdpid,p[This],TRUE);
-    MUTEX_UNLOCK(&PL_fdpid_mutex);
+    UNLOCK_FDPID_MUTEX;
     (void)SvUPGRADE(sv,SVt_IV);
     SvIVX(sv) = pid;
     PL_forkprocess = pid;
@@ -2622,9 +2622,9 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
     int saved_win32_errno;
 #endif
 
-    MUTEX_LOCK(&PL_fdpid_mutex);
+    LOCK_FDPID_MUTEX;
     svp = av_fetch(PL_fdpid,PerlIO_fileno(ptr),TRUE);
-    MUTEX_UNLOCK(&PL_fdpid_mutex);
+    UNLOCK_FDPID_MUTEX;
     pid = SvIVX(*svp);
     SvREFCNT_dec(*svp);
     *svp = &PL_sv_undef;
@@ -3497,7 +3497,7 @@ Perl_condpair_magic(pTHX_ SV *sv)
 }
 
 SV *
-Perl_lock(pTHX_ SV *osv)
+Perl_sv_lock(pTHX_ SV *osv)
 {
     MAGIC *mg;
     SV *sv = osv;
@@ -3513,17 +3513,18 @@ Perl_lock(pTHX_ SV *osv)
     MUTEX_LOCK(MgMUTEXP(mg));
     if (MgOWNER(mg) == thr)
 	MUTEX_UNLOCK(MgMUTEXP(mg));
-     else {
+    else {
 	while (MgOWNER(mg))
 	    COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
 	MgOWNER(mg) = thr;
-	DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": Perl_lock lock 0x%"UVxf"\n",
+	DEBUG_S(PerlIO_printf(Perl_debug_log,
+			      "0x%"UVxf": Perl_lock lock 0x%"UVxf"\n",
 			      PTR2UV(thr), PTR2UV(sv));)
 	MUTEX_UNLOCK(MgMUTEXP(mg));
 	SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv);
     }
-  SvUNLOCK(sv);
-  return sv;
+    SvUNLOCK(sv);
+    return sv;
 }
 
 /*
diff --git a/win32/Makefile b/win32/Makefile
index d669516974..f5ee4c6482 100644
--- a/win32/Makefile
+++ b/win32/Makefile
@@ -972,6 +972,8 @@ utils: $(PERLEXE) $(X2P)
 	copy ..\vms\perlvms.pod .\perlvms.pod
 	copy ..\README.win32 .\perlwin32.pod
 	$(MAKE) -f ..\win32\pod.mak converters
+	cd ..\lib
+	$(PERLEXE) lib.pm.PL
 	cd ..\win32
 	$(PERLEXE) $(PL2BAT) $(UTILS)
 
diff --git a/win32/win32.c b/win32/win32.c
index a05a3fe8a6..a4e1a7938b 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -2390,9 +2390,9 @@ win32_popen(const char *command, const char *mode)
 	/* close saved handle */
 	win32_close(oldfd);
 
-	MUTEX_LOCK(&PL_fdpid_mutex);
+	LOCK_FDPID_MUTEX;
 	sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid);
-	MUTEX_UNLOCK(&PL_fdpid_mutex);
+	UNLOCK_FDPID_MUTEX;
 
 	/* set process id so that it can be returned by perl's open() */
 	PL_forkprocess = childpid;
@@ -2428,9 +2428,9 @@ win32_pclose(FILE *pf)
     int childpid, status;
     SV *sv;
 
-    MUTEX_LOCK(&PL_fdpid_mutex);
+    LOCK_FDPID_MUTEX;
     sv = *av_fetch(w32_fdpid, win32_fileno(pf), TRUE);
-    MUTEX_UNLOCK(&PL_fdpid_mutex);
+
     if (SvIOK(sv))
 	childpid = SvIVX(sv);
     else
@@ -2443,6 +2443,7 @@ win32_pclose(FILE *pf)
 
     win32_fclose(pf);
     SvIVX(sv) = 0;
+    UNLOCK_FDPID_MUTEX;
 
     if (win32_waitpid(childpid, &status, 0) == -1)
         return -1;