From cc9b67681954df413fe79f7c379e7b91a3121259 Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Fri, 9 Jun 2000 13:38:29 +0000 Subject: [PATCH] Rename the fdpid locking and integrate with Sarathy. p4raw-id: //depot/cfgperl@6217 --- av.h | 4 ++-- cop.h | 17 +++++++++-------- doio.c | 4 ++-- hints/solaris_2.sh | 2 +- pp_ctl.c | 2 +- sv.h | 7 ------- t/op/runlevel.t | 15 +++++++++++++++ util.c | 8 ++++---- vmesa/vmesa.c | 16 ++++++++-------- win32/win32.c | 8 ++++---- 10 files changed, 46 insertions(+), 37 deletions(-) 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 -- 2.7.4