Win32 patches for cfgperl from Sarathy.

p4raw-id: //depot/cfgperl@6307

diff --git a/doio.c b/doio.c
index 6f62144..d253f98 100644 (file)
--- 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 3394db2..0c6e690 100644 (file)
--- 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 6fc3721..928be19 100644 (file)
--- 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 7e94a09..3d4f3bb 100755 (executable)
--- 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 9053446..719e50a 100644 (file)
--- 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 e24fc45..f18f174 100644 (file)
--- 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 108993c..a02a298 100644 (file)
--- 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 4f51cb8..0209fd3 100644 (file)
--- 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 97f8d29..1469be9 100644 (file)
--- 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 26d559a..6a54b94 100755 (executable)
--- 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 efea0c1..1649cf4 100644 (file)
--- 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 9400760..a924d2e 100644 (file)
--- 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 8d35b7e..ea2b932 100644 (file)
--- 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 e7a21c3..bd222fe 100644 (file)
--- 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 0ea9e74..8234360 100644 (file)
--- 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 d6bb6d9..fc51d91 100644 (file)
--- 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 e0f1f14..d892e75 100644 (file)
--- 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 d669516..f5ee4c6 100644 (file)
--- 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 a05a3fe..a4e1a79 100644 (file)
--- 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;