integrate cfgperl changes#6207..6210 into mainline
authorGurusamy Sarathy <gsar@cpan.org>
Tue, 11 Jul 2000 17:36:42 +0000 (17:36 +0000)
committerGurusamy Sarathy <gsar@cpan.org>
Tue, 11 Jul 2000 17:36:42 +0000 (17:36 +0000)
p4raw-link: @6210 on //depot/cfgperl: b8b4c9f3cf6ef09c878a80ff97526a69902a44ca
p4raw-link: @6207 on //depot/cfgperl: b37a7757477319a5fcdd5131db15046064f631c4

p4raw-id: //depot/perl@6345

14 files changed:
doio.c
embed.h
embed.pl
gv.c
intrpvar.h
objXSUB.h
perl.c
pp.c
pp_ctl.c
proto.h
sv.h
util.c
vmesa/vmesa.c
win32/win32.c

diff --git a/doio.c b/doio.c
index 0121633..6d03b20 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -476,11 +476,13 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
            SV *sv;
 
            PerlLIO_dup2(PerlIO_fileno(fp), fd);
+           FDPID_LOCK;
            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);
+           FDPID_UNLOCK;
            (void)SvUPGRADE(sv, SVt_IV);
            SvIVX(sv) = pid;
            if (!was_fdopen)
diff --git a/embed.h b/embed.h
index ed1f34e..ad2e738 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define xstat                  S_xstat
 #  endif
 #endif
+#define lock                   Perl_lock
 #if defined(PERL_OBJECT)
 #endif
 #define ck_anoncode            Perl_ck_anoncode
 #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)
 #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
index 16a0697..7afe36d 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -2498,6 +2498,8 @@ s |void   |xstat          |int
 #  endif
 #endif
 
+Arp    |SV*    |lock           |SV *sv
+
 #if defined(PERL_OBJECT)
 };
 #endif
diff --git a/gv.c b/gv.c
index 1868114..1c3a953 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -435,9 +435,18 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
      */
     varstash = GvSTASH(CvGV(cv));
     vargv = *(GV**)hv_fetch(varstash, autoload, autolen, TRUE);
+    ENTER;
+
+#ifdef USE_THREADS
+    Perl_lock(aTHX_ (SV *)varstash);
+#endif
     if (!isGV(vargv))
        gv_init(vargv, varstash, autoload, autolen, FALSE);
+    LEAVE;
     varsv = GvSV(vargv);
+#ifdef USE_THREADS
+    Perl_lock(aTHX_ varsv);
+#endif
     sv_setpv(varsv, HvNAME(stash));
     sv_catpvn(varsv, "::", 2);
     sv_catpvn(varsv, name, len);
index 9d513f7..d686413 100644 (file)
@@ -140,6 +140,10 @@ PERLVAR(Iforkprocess,      int)            /* so do_open |- can return proc# */
 /* subprocess state */
 PERLVAR(Ifdpid,                AV *)           /* keep fd-to-pid mappings for my_popen */
 
+#ifdef USE_THREADS
+PERLVAR(Ifdpid_mutex,  perl_mutex)     /* mutex for fdpid array */
+#endif
+
 /* internal state */
 PERLVAR(Itainting,     bool)           /* doing taint checks */
 PERLVARI(Iop_mask,     char *, NULL)   /* masked operations for safe evals */
@@ -456,4 +460,8 @@ PERLVAR(IProc,              struct IPerlProc*)
 PERLVAR(Iptr_table,    PTR_TBL_t*)
 #endif
 
+#if defined(USE_THREADS)
+PERLVAR(Isv_lock_mutex,        perl_mutex)     /* Mutex for SvLOCK macro */
+#endif
+
 PERLVAR(Inullstash,    HV *)           /* illegal symbols end up here */
index b5ee212..88ea89c 100644 (file)
--- a/objXSUB.h
+++ b/objXSUB.h
 #  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/perl.c b/perl.c
index 3947f28..3c32a4e 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -180,6 +180,8 @@ perl_construct(pTHXx)
 #  endif /* EMULATE_ATOMIC_REFCOUNTS */
        
        MUTEX_INIT(&PL_cred_mutex);
+       MUTEX_INIT(&PL_sv_lock_mutex);
+       MUTEX_INIT(&PL_fdpid_mutex);
 
        thr = init_main_thread();
 #endif /* USE_THREADS */
@@ -728,6 +730,7 @@ perl_destruct(pTHXx)
     MUTEX_DESTROY(&PL_sv_mutex);
     MUTEX_DESTROY(&PL_eval_mutex);
     MUTEX_DESTROY(&PL_cred_mutex);
+    MUTEX_DESTROY(&PL_fdpid_mutex);
     COND_DESTROY(&PL_eval_cond);
 #ifdef EMULATE_ATOMIC_REFCOUNTS
     MUTEX_DESTROY(&PL_svref_mutex);
diff --git a/pp.c b/pp.c
index fc3a4a7..428b2e4 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -5257,24 +5257,7 @@ PP(pp_lock)
     dTOPss;
     SV *retsv = sv;
 #ifdef USE_THREADS
-    MAGIC *mg;
-
-    if (SvROK(sv))
-       sv = SvRV(sv);
-
-    mg = condpair_magic(sv);
-    MUTEX_LOCK(MgMUTEXP(mg));
-    if (MgOWNER(mg) == thr)
-       MUTEX_UNLOCK(MgMUTEXP(mg));
-    else {
-       while (MgOWNER(mg))
-           COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
-       MgOWNER(mg) = thr;
-       DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": pp_lock lock 0x%"UVxf"\n",
-                             PTR2UV(thr), PTR2UV(sv));)
-       MUTEX_UNLOCK(MgMUTEXP(mg));
-       SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv);
-    }
+    Perl_lock(aTHX_ sv);
 #endif /* USE_THREADS */
     if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV
        || SvTYPE(retsv) == SVt_PVCV) {
index 9af9e82..9400760 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -891,6 +891,10 @@ PP(pp_sort)
                    PL_secondgv = gv_fetchpv("b", TRUE, SVt_PV);
                    PL_sortstash = stash;
                }
+#ifdef USE_THREADS
+               Perl_lock(aTHX_ (SV *)PL_firstgv);
+               Perl_lock(aTHX_ (SV *)PL_secondgv);
+#endif
                SAVESPTR(GvSV(PL_firstgv));
                SAVESPTR(GvSV(PL_secondgv));
            }
diff --git a/proto.h b/proto.h
index e16fcd6..b3888d5 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1260,6 +1260,8 @@ 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/sv.h b/sv.h
index c0ce967..f350498 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -123,21 +123,26 @@ perform the upgrade if necessary.  See C<svtype>.
 
 #ifdef USE_THREADS
 
-#  ifdef EMULATE_ATOMIC_REFCOUNTS
-#    define ATOMIC_INC(count) STMT_START {     \
-       MUTEX_LOCK(&PL_svref_mutex);            \
-       ++count;                                \
-       MUTEX_UNLOCK(&PL_svref_mutex);          \
-     } STMT_END
-#    define ATOMIC_DEC_AND_TEST(res,count) STMT_START {        \
-       MUTEX_LOCK(&PL_svref_mutex);                    \
-       res = (--count == 0);                           \
-       MUTEX_UNLOCK(&PL_svref_mutex);                  \
-     } STMT_END
-#  else
-#    define ATOMIC_INC(count) atomic_inc(&count)
-#    define ATOMIC_DEC_AND_TEST(res,count) (res = atomic_dec_and_test(&count))
-#  endif /* EMULATE_ATOMIC_REFCOUNTS */
+#  if defined(VMS)
+#    define ATOMIC_INC(count) __ATOMIC_INCREMENT_LONG(&count)
+#    define ATOMIC_DEC_AND_TEST(res,count) res=(1==__ATOMIC_DECREMENT_LONG(&count))
+ #  else
+#    ifdef EMULATE_ATOMIC_REFCOUNTS
+ #      define ATOMIC_INC(count) STMT_START {  \
+         MUTEX_LOCK(&PL_svref_mutex);          \
+         ++count;                              \
+         MUTEX_UNLOCK(&PL_svref_mutex);                \
+       } STMT_END
+#      define ATOMIC_DEC_AND_TEST(res,count) STMT_START {      \
+         MUTEX_LOCK(&PL_svref_mutex);                  \
+         res = (--count == 0);                         \
+         MUTEX_UNLOCK(&PL_svref_mutex);                        \
+       } STMT_END
+#    else
+#      define ATOMIC_INC(count) atomic_inc(&count)
+#      define ATOMIC_DEC_AND_TEST(res,count) (res = atomic_dec_and_test(&count))
+#    endif /* EMULATE_ATOMIC_REFCOUNTS */
+#  endif /* VMS */
 #else
 #  define ATOMIC_INC(count) (++count)
 #  define ATOMIC_DEC_AND_TEST(res, count) (res = (--count == 0))
@@ -153,7 +158,12 @@ perform the upgrade if necessary.  See C<svtype>.
     })
 #else
 #  if defined(CRIPPLED_CC) || defined(USE_THREADS)
-#    define SvREFCNT_inc(sv) sv_newref((SV*)sv)
+#    if defined(VMS) && defined(__ALPHA)
+#      define SvREFCNT_inc(sv) \
+          (PL_Sv=(SV*)(sv), (PL_Sv && __ATOMIC_INCREMENT_LONG(&(SvREFCNT(PL_Sv)))), (SV *)PL_Sv)
+#    else
+#      define SvREFCNT_inc(sv) sv_newref((SV*)sv)
+#    endif
 #  else
 #    define SvREFCNT_inc(sv)   \
        ((PL_Sv=(SV*)(sv)), (PL_Sv && ATOMIC_INC(SvREFCNT(PL_Sv))), (SV*)PL_Sv)
@@ -997,6 +1007,13 @@ indicated number of bytes (remember to reserve space for an extra trailing
 NUL character).  Calls C<sv_grow> to perform the expansion if necessary. 
 Returns a pointer to the character buffer.
 
+=for apidoc Am|void|SvLOCK|SV* sv
+Aquires an internal mutex for a SV. Used to make sure multiple threads
+don't stomp on the guts of an SV at the same time
+
+=for apidoc Am|void|SvUNLOCK|SV* sv
+Release the internal mutex for an SV.
+
 =cut
 */
 
@@ -1032,6 +1049,9 @@ Returns a pointer to the character buffer.
                SvSetSV_nosteal_and(dst,src,SvSETMAGIC(dst))
 
 #ifdef DEBUGGING
+
+#define SvLOCK(sv)     MUTEX_LOCK(&PL_sv_lock_mutex)
+#define SvUNLOCK(sv)   MUTEX_UNLOCK(&PL_sv_lock_mutex)
 #define SvPEEK(sv) sv_peek(sv)
 #else
 #define SvPEEK(sv) ""
@@ -1045,3 +1065,11 @@ Returns a pointer to the character buffer.
 
 #define SvGROW(sv,len) (SvLEN(sv) < (len) ? sv_grow(sv,len) : SvPVX(sv))
 #define Sv_Grow sv_grow
+
+#ifdef USE_THREADS
+#   define FDPID_LOCK          MUTEX_LOCK(&PL_fdpid_mutex)
+#   define FDPID_UNLOCK                MUTEX_UNLOCK(&PL_fdpid_mutex)
+#else
+#   define FDPID_LOCK
+#   define FDPID_UNLOCK
+#endif
diff --git a/util.c b/util.c
index 8962fff..38591e9 100644 (file)
--- a/util.c
+++ b/util.c
@@ -2402,7 +2402,9 @@ Perl_my_popen(pTHX_ char *cmd, char *mode)
        PerlLIO_close(p[This]);
        p[This] = p[that];
     }
+    FDPID_LOCK;
     sv = *av_fetch(PL_fdpid,p[This],TRUE);
+    FDPID_UNLOCK;
     (void)SvUPGRADE(sv,SVt_IV);
     SvIVX(sv) = pid;
     PL_forkprocess = pid;
@@ -2620,7 +2622,9 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
     int saved_win32_errno;
 #endif
 
+    FDPID_LOCK;
     svp = av_fetch(PL_fdpid,PerlIO_fileno(ptr),TRUE);
+    FDPID_UNLOCK;
     pid = SvIVX(*svp);
     SvREFCNT_dec(*svp);
     *svp = &PL_sv_undef;
@@ -3492,6 +3496,36 @@ Perl_condpair_magic(pTHX_ SV *sv)
     return mg;
 }
 
+SV *
+Perl_lock(pTHX_ SV *osv)
+{
+    MAGIC *mg;
+    SV *sv = osv;
+
+    SvLOCK(osv);
+    if (SvROK(sv)) {
+       sv = SvRV(sv);
+       SvUNLOCK(osv);
+       SvLOCK(sv);
+    }
+
+    mg = condpair_magic(sv);
+    MUTEX_LOCK(MgMUTEXP(mg));
+    if (MgOWNER(mg) == thr)
+       MUTEX_UNLOCK(MgMUTEXP(mg));
+     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",
+                             PTR2UV(thr), PTR2UV(sv));)
+       MUTEX_UNLOCK(MgMUTEXP(mg));
+       SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv);
+    }
+  SvUNLOCK(sv);
+  return sv;
+}
+
 /*
  * Make a new perl thread structure using t as a prototype. Some of the
  * fields for the new thread are copied from the prototype thread, t,
index 0e7894a..b396380 100644 (file)
@@ -182,11 +182,13 @@ do_aspawn(SV* really, SV **mark, SV **sp)
              /* be used by my_pclose                        */
              /*---------------------------------------------*/
              close(fd);
+             FDPID_LOCK;
              p_sv  = av_fetch(PL_fdpid,fd,TRUE);
              fd    = (int) SvIVX(*p_sv);
              SvREFCNT_dec(*p_sv);
              *p_sv = &PL_sv_undef;
              sv    = *av_fetch(PL_fdpid,fd,TRUE);
+             FDPID_UNLOCK;
              (void) SvUPGRADE(sv, SVt_IV);
              SvIVX(sv) = pid;
              status    = 0;
@@ -408,11 +410,13 @@ my_popen(char *cmd, char *mode)
          Perl_stdin_fd = pFd[that];
       if (strNE(cmd,"-"))
       {
-        PERL_FLUSHALL_FOR_CHILD;
+         PERL_FLUSHALL_FOR_CHILD;
          pid = spawn_cmd(cmd, Perl_stdin_fd, Perl_stdout_fd);
          if (pid >= 0)
          {
+            FDPID_LOCK;
             sv = *av_fetch(PL_fdpid,pFd[this],TRUE);
+            FDPID_UNLOCK;
             (void) SvUPGRADE(sv, SVt_IV);
             SvIVX(sv) = pid;
             fd = PerlIO_fdopen(pFd[this], mode);
@@ -423,7 +427,9 @@ my_popen(char *cmd, char *mode)
       }
       else
       {
+         FDPID_LOCK;
          sv = *av_fetch(PL_fdpid,pFd[that],TRUE);
+         FDPID_UNLOCK;
          (void) SvUPGRADE(sv, SVt_IV);
          SvIVX(sv) = pFd[this];
          fd = PerlIO_fdopen(pFd[this], mode);
@@ -460,7 +466,9 @@ my_pclose(FILE *fp)
  SV   **sv;
  FILE *other;
 
+   FDPID_LOCK;
    sv        = av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE);
+   FDPID_UNLOCK;
    pid       = (int) SvIVX(*sv);
    SvREFCNT_dec(*sv);
    *sv       = &PL_sv_undef;
index 1ba2e51..c94d4c5 100644 (file)
@@ -2393,7 +2393,9 @@ win32_popen(const char *command, const char *mode)
        /* close saved handle */
        win32_close(oldfd);
 
+       FDPID_LOCK;
        sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid);
+       FDPID_UNLOCK;
 
        /* set process id so that it can be returned by perl's open() */
        PL_forkprocess = childpid;
@@ -2429,7 +2431,9 @@ win32_pclose(FILE *pf)
     int childpid, status;
     SV *sv;
 
+    FDPID_LOCK;
     sv = *av_fetch(w32_fdpid, win32_fileno(pf), TRUE);
+    FDPID_UNLOCK;
     if (SvIOK(sv))
        childpid = SvIVX(sv);
     else