develooper Front page | perl.perl5.porters | Postings from July 2012

slab alocator, CvSTART of PL_main_cv and Devel::Size (was Re:[perl.git] branch blead, updated. v5.17.1-240-gc5fb998)

From:
Nicholas Clark
Date:
July 18, 2012 14:38
Subject:
slab alocator, CvSTART of PL_main_cv and Devel::Size (was Re:[perl.git] branch blead, updated. v5.17.1-240-gc5fb998)
Message ID:
20120718213827.GA22938@plum.flirble.org
Thanks for fixing these long standing problems.

But, a little fun emerged...

On Fri, Jun 29, 2012 at 09:25:02AM +0200, Father Chrysostomos wrote:

>     CVs use the new CVf_SLABBED flag to indicate that the CV has a refer-
>     ence count on the slab.  When this flag is set, the slab is accessible
>     via CvSTART when CvROOT is not set, or by subtracting two pointers
>     (2*sizeof(I32 *)) from CvROOT when it is set.  I decided to sneak the
>     slab into CvSTART during compilation, because enlarging the xpvcv
>     struct by another pointer would make all CVs larger, even though this
>     patch only benefits few (programs using string eval).
>
>     When the CVf_SLABBED flag is set, the CV takes responsibility for
>     freeing the slab.  If CvROOT is not set when the CV is freed or
>     undeffed, it is assumed that a compilation error has occurred, so the
>     op slab is traversed and all the ops are freed.
>     
>     Under normal circumstances, the CV forgets about its slab (decrement-
>     ing the reference count) when the root is attached.  So the slab ref-
>     erence counting that happens when ops are freed takes care of free-
>     ing the slab.  In some cases, the CV is told to forget about the slab
>     (cv_forget_slab) precisely so that the ops can survive after the CV is
>     done away with.
>     
>     Forgetting the slab when the root is attached is not strictly neces-
>     sary, but avoids potential problems with CvROOT being written over.
>     There is code all over the place, both in core and on CPAN, that does
>     things with CvROOT, so forgetting the slab makes things more robust
>     and avoids potential problems.

>     All of this is kept under lock and key via #ifdef PERL_CORE, as it
>     should be completely transparent.  If it isn't transparent, I would
>     consider that a bug.

It is visible in at least one way outside the core - CvSTART() of PL_main_cv
ends up being left with a value long after compiling is finished.

Devel::Size::total_size when passed a subroutine reference ends up chasing
CvOUTSIDE pointers to PL_main_cv [whether it *should* is a different
question], and then follows CvSTART() and gets very upset because it's not
actually ops.

At 8be227ab5eaa23f2^

Breakpoint 1, perl_run (my_perl=0x7d4010) at perl.c:2310
2310       int ret = 0;
(gdb) call Perl_sv_dump(PL_main_cv)
SV = PVCV(0x7e2e90) at 0x7d6fc8
  REFCNT = 1
  FLAGS = (UNIQUE)
  COMP_STASH = 0x0
  ROOT = 0x0
  GVGV::GV = 0x0
  FILE = "(null)"
  DEPTH = 0
  FLAGS = 0x100
  OUTSIDE_SEQ = 0
  PADLIST = 0x7d6fe0
  OUTSIDE = 0x0 (null)

After that:

Breakpoint 1, perl_run (my_perl=0x100600080) at perl.c:2306
2306        int ret = 0;
(gdb) call Perl_sv_dump(PL_main_cv)
SV = PVCV(0x10080ee00) at 0x1008030c8
  REFCNT = 1
  FLAGS = (UNIQUE)
  COMP_STASH = 0x0
  START = 0x100609020 ===> 1
  ROOT = 0x0
  GVGV::GV = 0x0
  FILE = "(null)"
  DEPTH = 0
  FLAGS = 0x100
  OUTSIDE_SEQ = 0
  PADLIST = 0x1008030e0
  OUTSIDE = 0x0 (null)


This seems to fix things so that PL_main_cv doesn't retain a pointer to
something it no longer owns:

git diff
diff --git a/pad.c b/pad.c
index 0077e5b..90a6ee1 100644
--- a/pad.c
+++ b/pad.c
@@ -504,8 +504,12 @@ Perl_cv_forget_slab(pTHX_ CV *cv)
     if      (CvROOT(cv))  slab = OpSLAB(CvROOT(cv));
     else if (CvSTART(cv)) slab = (OPSLAB *)CvSTART(cv);
 #else
-    if      (CvROOT(cv))  OpslabREFCNT_dec(OpSLAB(CvROOT(cv)));
-    else if (CvSTART(cv)) OpslabREFCNT_dec((OPSLAB *)CvSTART(cv));
+    if      (CvROOT(cv))
+        OpslabREFCNT_dec(OpSLAB(CvROOT(cv)));
+    else if (CvSTART(cv)) {
+        OpslabREFCNT_dec((OPSLAB *)CvSTART(cv));
+        CvSTART(cv) = NULL;
+    }
 #endif
 #ifdef DEBUGGING
     else if (slabbed)     Perl_warn(aTHX_ "Slab leaked from cv %p", cv);


[oops. Didn't mean to reformat that previous line]

With that:

Breakpoint 1, perl_run (my_perl=0x9cc010) at perl.c:2306
2306       int ret = 0;
(gdb) call Perl_sv_dump(PL_main_cv)
SV = PVCV(0x9dafa0) at 0x9cefc8
  REFCNT = 1
  FLAGS = (UNIQUE)
  COMP_STASH = 0x0
  ROOT = 0x0
  GVGV::GV = 0x0
  FILE = "(null)"
  DEPTH = 0
  FLAGS = 0x100
  OUTSIDE_SEQ = 0
  PADLIST = 0x9cefe0
  OUTSIDE = 0x0 (null)

and CvSTART() isn't pointing to bogus things.

However, to demonstrate that I don't know what I'm doing here, I thought
that *this* also should work:

$ git diff
diff --git a/pad.c b/pad.c
index 0077e5b..e934447 100644
--- a/pad.c
+++ b/pad.c
@@ -504,8 +504,15 @@ Perl_cv_forget_slab(pTHX_ CV *cv)
     if      (CvROOT(cv))  slab = OpSLAB(CvROOT(cv));
     else if (CvSTART(cv)) slab = (OPSLAB *)CvSTART(cv);
 #else
-    if      (CvROOT(cv))  OpslabREFCNT_dec(OpSLAB(CvROOT(cv)));
-    else if (CvSTART(cv)) OpslabREFCNT_dec((OPSLAB *)CvSTART(cv));
+    if      (CvROOT(cv)) {
+        OpslabREFCNT_dec(OpSLAB(CvROOT(cv)));
+        CvROOT(cv) = NULL;
+        CvSTART(cv) = NULL;
+    }
+    else if (CvSTART(cv)) {
+        OpslabREFCNT_dec((OPSLAB *)CvSTART(cv));
+        CvSTART(cv) = NULL;
+    }
 #endif
 #ifdef DEBUGGING
     else if (slabbed)     Perl_warn(aTHX_ "Slab leaked from cv %p", cv);

but it fails assertions in several tests, eg:

$ ./perl t/comp/form_scope.t
1..10
perl: pp_ctl.c:4221: Perl_delete_eval_scope: Assertion `((char*)PL_scopestack_name[PL_scopestack_ix-1] == (char*)"eval_scope") || (!strcmp(PL_scopestack_name[PL_scopestack_ix-1],"eval_scope"))' failed.
Aborted


Nicholas Clark



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