From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Fri, 9 Jun 2000 13:38:29 +0000 (+0000)
Subject: Rename the fdpid locking and integrate with Sarathy.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cc9b67681954df413fe79f7c379e7b91a3121259;p=p5sagit%2Fp5-mst-13.2.git

Rename the fdpid locking and integrate with Sarathy.

p4raw-id: //depot/cfgperl@6217
---

diff --git a/av.h b/av.h
index 6b66bfd..4a18430 100644
--- a/av.h
+++ b/av.h
@@ -32,8 +32,8 @@ struct xpvav {
  * real if the array needs to be modified in some way.  Functions that
  * modify fake AVs check both flags to call av_reify() as appropriate.
  *
- * Note that the Perl stack has neither flag set. (Thus, items that go
- * on the stack are never refcounted.)
+ * Note that the Perl stack and @DB::args have neither flag set. (Thus,
+ * items that go on the stack are never refcounted.)
  *
  * These internal details are subject to change any time.  AV
  * manipulations external to perl should not care about any of this.
diff --git a/cop.h b/cop.h
index d6fdd23..e0a8127 100644
--- a/cop.h
+++ b/cop.h
@@ -106,13 +106,14 @@ struct block_sub {
     } STMT_END
 #endif /* USE_THREADS */
 
-#ifdef USE_ITHREADS
-   /* junk in @_ spells trouble when cloning CVs, so don't leave any */
-#  define CLEAR_ARGARRAY()	av_clear(cx->blk_sub.argarray)
-#else
-#  define CLEAR_ARGARRAY()	NOOP
-#endif /* USE_ITHREADS */
-
+/* junk in @_ spells trouble when cloning CVs and in pp_caller(), so don't
+ * leave any (a fast av_clear(ary), basically) */
+#define CLEAR_ARGARRAY(ary) \
+    STMT_START {							\
+	AvMAX(ary) += AvARRAY(ary) - AvALLOC(ary);			\
+	SvPVX(ary) = (char*)AvALLOC(ary);				\
+	AvFILLp(ary) = -1;						\
+    } STMT_END
 
 #define POPSUB(cx,sv)							\
     STMT_START {							\
@@ -128,7 +129,7 @@ struct block_sub {
 		PL_curpad[0] = (SV*)cx->blk_sub.argarray;		\
 	    }								\
 	    else {							\
-		CLEAR_ARGARRAY();					\
+		CLEAR_ARGARRAY(cx->blk_sub.argarray);			\
 	    }								\
 	}								\
 	sv = (SV*)cx->blk_sub.cv;					\
diff --git a/doio.c b/doio.c
index 6d03b20..970eaed 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);
-	    FDPID_LOCK;
+	    MUTEX_LOCK(&PL_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);
-	    FDPID_UNLOCK;
+	    MUTEX_UNLOCK(&PL_fdpid_mutex);
 	    (void)SvUPGRADE(sv, SVt_IV);
 	    SvIVX(sv) = pid;
 	    if (!was_fdopen)
diff --git a/hints/solaris_2.sh b/hints/solaris_2.sh
index 48fbbff..8aee6d4 100644
--- a/hints/solaris_2.sh
+++ b/hints/solaris_2.sh
@@ -77,7 +77,7 @@ case "$ccisworkshop" in
 int main() { return(0); }
 EOF
 	workshoplibs=`cc -### try.c -lsunmath -o try 2>&1|grep " -Y "|sed 's%.* -Y "P,\(.*\)".*%\1%'|tr ':' '\n'|grep '/SUNWspro/'`
-	. ./workshoplibpth.cbu
+	. ./UU/workshoplibpth.cbu
 	;;
 esac
 
diff --git a/pp_ctl.c b/pp_ctl.c
index 995c202..a218683 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1559,7 +1559,7 @@ PP(pp_caller)
 	    PL_dbargs = GvAV(gv_AVadd(tmpgv = gv_fetchpv("DB::args", TRUE,
 				SVt_PVAV)));
 	    GvMULTI_on(tmpgv);
-	    AvREAL_off(PL_dbargs);		/* XXX Should be REIFY */
+	    AvREAL_off(PL_dbargs);	/* XXX should be REIFY (see av.h) */
 	}
 
 	if (AvMAX(PL_dbargs) < AvFILLp(ary) + off)
diff --git a/sv.h b/sv.h
index f350498..0e12554 100644
--- a/sv.h
+++ b/sv.h
@@ -1066,10 +1066,3 @@ Release the internal mutex for an SV.
 #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/t/op/runlevel.t b/t/op/runlevel.t
index e988ad9..3865e52 100755
--- a/t/op/runlevel.t
+++ b/t/op/runlevel.t
@@ -349,3 +349,18 @@ A 1
 bar
 B 2
 bar
+########
+sub n { 0 }
+sub f { my $x = shift; d(); }
+f(n());
+f();
+
+sub d {
+    my $i = 0; my @a;
+    while (do { { package DB; @a = caller($i++) } } ) {
+        @a = @DB::args;
+        for (@a) { print "$_\n"; $_ = '' }
+    }
+}
+EXPECT
+0
diff --git a/util.c b/util.c
index 38591e9..e0f1f14 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];
     }
-    FDPID_LOCK;
+    MUTEX_LOCK(&PL_fdpid_mutex);
     sv = *av_fetch(PL_fdpid,p[This],TRUE);
-    FDPID_UNLOCK;
+    MUTEX_UNLOCK(&PL_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
 
-    FDPID_LOCK;
+    MUTEX_LOCK(&PL_fdpid_mutex);
     svp = av_fetch(PL_fdpid,PerlIO_fileno(ptr),TRUE);
-    FDPID_UNLOCK;
+    MUTEX_UNLOCK(&PL_fdpid_mutex);
     pid = SvIVX(*svp);
     SvREFCNT_dec(*svp);
     *svp = &PL_sv_undef;
diff --git a/vmesa/vmesa.c b/vmesa/vmesa.c
index b396380..0e4ad86 100644
--- a/vmesa/vmesa.c
+++ b/vmesa/vmesa.c
@@ -182,13 +182,13 @@ do_aspawn(SV* really, SV **mark, SV **sp)
              /* be used by my_pclose                        */
              /*---------------------------------------------*/
              close(fd);
-             FDPID_LOCK;
+             MUTEX_LOCK(&PL_fdpid_mutex);
              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;
+             MUTEX_UNLOCK(&PL_fdpid_mutex);
              (void) SvUPGRADE(sv, SVt_IV);
              SvIVX(sv) = pid;
              status    = 0;
@@ -414,9 +414,9 @@ my_popen(char *cmd, char *mode)
          pid = spawn_cmd(cmd, Perl_stdin_fd, Perl_stdout_fd);
          if (pid >= 0)
          {
-            FDPID_LOCK;
+            MUTEX_LOCK(&PL_fdpid_mutex);
             sv = *av_fetch(PL_fdpid,pFd[this],TRUE);
-            FDPID_UNLOCK;
+            MUTEX_UNLOCK(&PL_fdpid_mutex);
             (void) SvUPGRADE(sv, SVt_IV);
             SvIVX(sv) = pid;
             fd = PerlIO_fdopen(pFd[this], mode);
@@ -427,9 +427,9 @@ my_popen(char *cmd, char *mode)
       }
       else
       {
-         FDPID_LOCK;
+         MUTEX_LOCK(&PL_fdpid_mutex);
          sv = *av_fetch(PL_fdpid,pFd[that],TRUE);
-         FDPID_UNLOCK;
+         MUTEX_UNLOCK(&PL_fdpid_mutex);
          (void) SvUPGRADE(sv, SVt_IV);
          SvIVX(sv) = pFd[this];
          fd = PerlIO_fdopen(pFd[this], mode);
@@ -466,9 +466,9 @@ my_pclose(FILE *fp)
  SV   **sv;
  FILE *other;
 
-   FDPID_LOCK;
+   MUTEX_LOCK(&PL_fdpid_mutex);
    sv        = av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE);
-   FDPID_UNLOCK;
+   MUTEX_UNLOCK(&PL_fdpid_mutex);
    pid       = (int) SvIVX(*sv);
    SvREFCNT_dec(*sv);
    *sv       = &PL_sv_undef;
diff --git a/win32/win32.c b/win32/win32.c
index 7cc8a27..2c81a58 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);
 
-	FDPID_LOCK;
+	MUTEX_LOCK(&PL_fdpid_mutex);
 	sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid);
-	FDPID_UNLOCK;
+	MUTEX_UNLOCK(&PL_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;
 
-    FDPID_LOCK;
+    MUTEX_LOCK(&PL_fdpid_mutex);
     sv = *av_fetch(w32_fdpid, win32_fileno(pf), TRUE);
-    FDPID_UNLOCK;
+    MUTEX_UNLOCK(&PL_fdpid_mutex);
     if (SvIOK(sv))
 	childpid = SvIVX(sv);
     else