develooper Front page | perl.perl5.porters | Postings from March 2001

Re: CvOUTSIDE

Thread Previous | Thread Next
From:
Gurusamy Sarathy
Date:
March 5, 2001 02:44
Subject:
Re: CvOUTSIDE
Message ID:
200103051043.f25AhWa20823@smtp3.ActiveState.com
On Sun, 04 Mar 2001 21:27:20 PST, Gurusamy Sarathy wrote:
>We simply need to find a reasonable way to break the loop.  The
>attached (highly experimental) patch does that and appears to cure
>the leak, but makes lib/safe{1,2}.t coredump.  I mean to look into
>it further a little later.

Here's the second iteration of that patch.  This one passes the
testsuite, but still has at least one problem with closures that
shows up when running Makefile.PL files for the extensions.
The MM_Unix.pm hunk works around the bug just so you can try it.

Just thought I'll show you what I have before retiring for the night.


Sarathy
gsar@ActiveState.com
-----------------------------------8<-----------------------------------
Index: perl/lib/ExtUtils/MM_Unix.pm
--- perl/lib/ExtUtils/MM_Unix.pm.~1~	Mon Mar  5 02:10:09 2001
+++ perl/lib/ExtUtils/MM_Unix.pm	Mon Mar  5 02:10:09 2001
@@ -1478,6 +1478,7 @@
 	print "Searching PMLIBDIRS: @{$self->{PMLIBDIRS}}\n"
 	    if ($Verbose >= 2);
 	require File::Find;
+	$::self = $self;		# XXXXXX temp hack, do not check in
 	File::Find::find(sub {
 	    if (-d $_){
 		if ($_ eq "CVS" || $_ eq "RCS"){
@@ -1490,9 +1491,9 @@
 	    my($striplibpath,$striplibname);
 	    $prefix =  '$(INST_LIB)' if (($striplibpath = $path) =~ s:^(\W*)lib\W:$1:i);
 	    ($striplibname,$striplibpath) = fileparse($striplibpath);
-	    my($inst) = $self->catfile($prefix,$striplibpath,$striplibname);
+	    my($inst) = $::self->catfile($prefix,$striplibpath,$striplibname);
 	    local($_) = $inst; # for backwards compatibility
-	    $inst = $self->libscan($inst);
+	    $inst = $::self->libscan($inst);
 	    print "libscan($path) => '$inst'\n" if ($Verbose >= 2);
 	    return unless $inst;
 	    $pm{$path} = $inst;
Index: perl/op.c
--- perl/op.c.~1~	Mon Mar  5 02:10:09 2001
+++ perl/op.c	Mon Mar  5 02:10:09 2001
@@ -4133,14 +4133,14 @@
 	SAVEVPTR(PL_curpad);
 	PL_curpad = 0;
 
-	if (!CvCLONED(cv))
-	    op_free(CvROOT(cv));
+	op_free(CvROOT(cv));
 	CvROOT(cv) = Nullop;
 	LEAVE;
     }
     SvPOK_off((SV*)cv);		/* forget prototype */
     CvGV(cv) = Nullgv;
-    SvREFCNT_dec(CvOUTSIDE(cv));
+    if (!CvANON(cv) || CvCLONED(cv))
+	SvREFCNT_dec(CvOUTSIDE(cv));
     CvOUTSIDE(cv) = Nullcv;
     if (CvPADLIST(cv)) {
 	/* may be during global destruction */
@@ -4248,7 +4248,7 @@
     CvFILE(cv)		= CvFILE(proto);
     CvGV(cv)		= CvGV(proto);
     CvSTASH(cv)		= CvSTASH(proto);
-    CvROOT(cv)		= CvROOT(proto);
+    CvROOT(cv)		= OpREFCNT_inc(CvROOT(proto));
     CvSTART(cv)		= CvSTART(proto);
     if (outside)
 	CvOUTSIDE(cv)	= (CV*)SvREFCNT_inc(outside);
@@ -4757,6 +4757,9 @@
 	    av_push(PL_initav, (SV*)cv);
 	    GvCV(gv) = 0;		/* cv has been hijacked */
 	}
+    }
+    else {
+	SvREFCNT_dec(CvOUTSIDE(cv));
     }
 
   done:
Index: perl/op.h
--- perl/op.h.~1~	Mon Mar  5 02:10:09 2001
+++ perl/op.h	Mon Mar  5 02:10:09 2001
@@ -410,18 +410,16 @@
 #  define OP_REFCNT_LOCK		MUTEX_LOCK(&PL_op_mutex)
 #  define OP_REFCNT_UNLOCK		MUTEX_UNLOCK(&PL_op_mutex)
 #  define OP_REFCNT_TERM		MUTEX_DESTROY(&PL_op_mutex)
-#  define OpREFCNT_set(o,n)		((o)->op_targ = (n))
-#  define OpREFCNT_inc(o)		((o) ? (++(o)->op_targ, (o)) : Nullop)
-#  define OpREFCNT_dec(o)		(--(o)->op_targ)
 #else
 #  define OP_REFCNT_INIT		NOOP
 #  define OP_REFCNT_LOCK		NOOP
 #  define OP_REFCNT_UNLOCK		NOOP
 #  define OP_REFCNT_TERM		NOOP
-#  define OpREFCNT_set(o,n)		NOOP
-#  define OpREFCNT_inc(o)		(o)
-#  define OpREFCNT_dec(o)		0
 #endif
+
+#define OpREFCNT_set(o,n)		((o)->op_targ = (n))
+#define OpREFCNT_inc(o)			((o) ? (++(o)->op_targ, (o)) : Nullop)
+#define OpREFCNT_dec(o)			(--(o)->op_targ)
 
 /* flags used by Perl_load_module() */
 #define PERL_LOADMOD_DENY		0x1
Index: perl/pp_ctl.c
--- perl/pp_ctl.c.~1~	Mon Mar  5 02:10:09 2001
+++ perl/pp_ctl.c	Mon Mar  5 02:10:09 2001
@@ -1336,41 +1336,6 @@
     }
 }
 
-/*
- * Closures mentioned at top level of eval cannot be referenced
- * again, and their presence indirectly causes a memory leak.
- * (Note that the fact that compcv and friends are still set here
- * is, AFAIK, an accident.)  --Chip
- *
- * XXX need to get comppad et al from eval's cv rather than
- * relying on the incidental global values.
- */
-STATIC void
-S_free_closures(pTHX)
-{
-    SV **svp = AvARRAY(PL_comppad_name);
-    I32 ix;
-    for (ix = AvFILLp(PL_comppad_name); ix >= 0; ix--) {
-	SV *sv = svp[ix];
-	if (sv && sv != &PL_sv_undef && *SvPVX(sv) == '&') {
-	    SvREFCNT_dec(sv);
-	    svp[ix] = &PL_sv_undef;
-
-	    sv = PL_curpad[ix];
-	    if (CvCLONE(sv)) {
-		SvREFCNT_dec(CvOUTSIDE(sv));
-		CvOUTSIDE(sv) = Nullcv;
-	    }
-	    else {
-		SvREFCNT_dec(sv);
-		sv = NEWSV(0,0);
-		SvPADTMP_on(sv);
-		PL_curpad[ix] = sv;
-	    }
-	}
-    }
-}
-
 void
 Perl_qerror(pTHX_ SV *err)
 {
@@ -1901,8 +1866,6 @@
 	POPEVAL(cx);
 	if (CxTRYBLOCK(cx))
 	    break;
-	if (AvFILLp(PL_comppad_name) >= 0)
-	    free_closures();
 	lex_end();
 	if (optype == OP_REQUIRE &&
 	    (MARK == SP || (gimme == G_SCALAR && !SvTRUE(*SP))) )
@@ -3444,9 +3407,6 @@
 	}
     }
     PL_curpm = newpm;	/* Don't pop $1 et al till now */
-
-    if (AvFILLp(PL_comppad_name) >= 0)
-	free_closures();
 
 #ifdef DEBUGGING
     assert(CvDEPTH(PL_compcv) == 1);
End of Patch.

Thread Previous | Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About