develooper Front page | perl.perl5.porters | Postings from October 2013

Re: [perl #119089] Shared references (threads::shared) disappear onsub return

Thread Previous
From:
Nicholas Clark
Date:
October 7, 2013 12:37
Subject:
Re: [perl #119089] Shared references (threads::shared) disappear onsub return
Message ID:
20131007123705.GE66035@plum.flirble.org
On Mon, Aug 12, 2013 at 04:41:14PM +0100, Dave Mitchell wrote:

> I had a quick play with trying to break blead in other ways; I though this
> should do it, but it doesn't, which confuses me:
> 
>     use threads ();
>     use threads::shared;
>     #use Devel::Peek;
> 
>     my $r;
>     {
> 	my @a :shared;
> 	$r = \$a[0];
> 	#Dump $r;
>     }
>     $r = 1;
> 
> So I feel less confident that I understand the issue fully.

To crash things, you need $$r not $r.
$r is a (Perl) reference to the (proxied) element, and it's the proxy that's
the problematic thing.

$r = 1; has the effect of dropping the reference to the proxied element.
Right now proxied elements assume that the aggregate will outlive them, so
they take no action on cleanup. So the sv_free() of the referent triggered
by $r = 1; does pretty much nothing.

Now, $$r = 1; is far more fun:

$ cat ../test/119089-dm.pl 
use threads ();
use threads::shared;

my $r;
{
    my @a :shared;
    $r = \$a[0];
}
$$r = 1;
__END__

$ ./perl -Ilib ../test/119089-dm.pl
perl: shared.xs:969: sharedsv_elem_mg_STORE: Assertion `mg->mg_ptr != 0' failed.
Aborted


This is because that that point saggregate has been freed, SvTYPE(saggregate)
is SV_TYPEMASK, an so it takes the "must be a hash" else block:

    if (SvTYPE(saggregate) == SVt_PVAV) {
        assert ( mg->mg_ptr == 0 );
        SHARED_CONTEXT;
        svp = av_fetch((AV*) saggregate, mg->mg_len, 1);
    } else {
        char *key = mg->mg_ptr;
        I32 len = mg->mg_len;
        assert ( mg->mg_ptr != 0 );

Boom!


Which gave me this idea:

$ cat ../test/119089-dm.pl 
use threads ();
use threads::shared;

my $r;
{
    my @a :shared;
    $r = \$a[0];
}
# $$r = 1;

my $a;
{
    my @a :shared;
    $a = \@a;
    $a->[0] = 2;
}

print "$a->[0]\n";
$$r = 3;
print "$a->[0]\n";
__END__

$ ./perl -Ilib ../test/119089-dm.pl
2
3


Accessing a different SV via the stale proxy. :-)


> > +int
> > +sharedsv_elem_mg_free(pTHX_ SV *sv, MAGIC *mg)
> > +{
> > +    dTHXc;
> > +    PERL_UNUSED_ARG(sv);
> > +    ENTER_LOCK;
> > +    if (mg->mg_obj) {
> > +        if (!PL_dirty) {
> > +            assert(SvROK(mg->mg_obj));
> > +        }
> > +        if (SvREFCNT(mg->mg_obj) == 1) {
> > +            /* If the element has the last pointer to the shared aggregate, then
> > +               it has to free the shared aggregate.  mg->mg_obj itself is freed
> > +               by Perl_mg_free()  */
> > +            S_sharedsv_dec(aTHX_ SHAREDSV_FROM_OBJ(mg->mg_obj));
> > +        }
> > +    }
> > +    LEAVE_LOCK;
> > +    return (0);
> > +}
> 
> I think the ENTER_LOCK and LEAVE_LOCK are superfluous in this function;
> its all done in private space apart from S_sharedsv_dec(), which does its
> own locking; and there's no savestack manipulation which would require the
> ENTER.

Yes, I think you're right. A bit too much un-thought-through cargo-culting on
my part. There's nothing that needs to be kept "in order" with shared space,
so no need to lock it against races with other threads.

I re-did the original commit with this simplification.

> >  sharedsv_array_mg_free(pTHX_ SV *sv, MAGIC *mg)
> >  {
> >      PERL_UNUSED_ARG(sv);
> > -    S_sharedsv_dec(aTHX_ (SV*)mg->mg_ptr);
> > +    if (!PL_dirty) {
> > +        assert(mg->mg_obj);
> > +        assert(SvROK(mg->mg_obj));
> > +        assert(SvUV(SvRV(mg->mg_obj)) == PTR2UV(mg->mg_ptr));
> > +    }
> > +    if (mg->mg_obj) {
> > +        if (SvREFCNT(mg->mg_obj) == 1) {
> > +            S_sharedsv_dec(aTHX_ (SV*)mg->mg_ptr);
> > +        } else {
> > +            /* An element of this aggregate still has PERL_MAGIC_tied(p)
> > +               pointing to this shared aggregate.  It will take responsibility
> > +               for freeing the shared aggregate.  Perl_mg_free() drops the
> > +               reference count on mg->mg_obj.  */
> > +        }
> > +    }
> >      return (0);
> >  }
> 
> IIUC, sharedsv_elem_mg_free() and sharedsv_array_mg_free() should be
> essentially the same code. They are both dealing with with an mg that has
> mg_obj => RV => MG whose IV => shared thing. I'm not sure whether the
> asserts in the two subs should be different (apart from the mg_ptr bit);
> in particular, whether sharedsv_elem_mg_free() should be skipping the
> assert(mg->mg_obj) in the non-dirty case.

I think that you're right that they can be the same. I don't think that
mg->mg_obj should ever be NULL in the non-dirty case so I kept that assert.

In the branch the function now looks like this:

int
sharedsv_array_mg_free(pTHX_ SV *sv, MAGIC *mg)
{
    PERL_UNUSED_ARG(sv);
    if (!PL_dirty) {
        assert(mg->mg_obj);
        assert(SvROK(mg->mg_obj));
        if (mg->mg_type == PERL_MAGIC_tied) {
            /* Only aggregates have this alternative shortcut.  */
            assert(SvUV(SvRV(mg->mg_obj)) == PTR2UV(mg->mg_ptr));
        }
    }
    if (mg->mg_obj) {
        if (SvREFCNT(mg->mg_obj) == 1) {
            /* There is only one proxy object per thread, stored in mg->mg_obj,
               which ends up being referenced by both the aggregate and any
               elements. Perl_mg_free() drops the reference count on
               mg->mg_obj, but if this is the last reference (and the proxy is
               about to be freed) then we need to manually drop the reference
               on the original aggregate in shared space.  */
            S_sharedsv_dec(aTHX_ SHAREDSV_FROM_OBJ(mg->mg_obj));
        }
    }
    return (0);
}

I've re-pushed this as smoke-me/nicholas/RT119089-variant

On Fri, Oct 04, 2013 at 06:10:27AM -0700, Dominic Hargreaves via RT wrote:

> Hmm, I can't see the subsequent question from Dave on this ticket. I'd 
> be interested in knowing about it even if there isn't an answer for it 
> yet, since this patch is queued for a Debian point release update in a 
> bid to fix the original regression. If there are sufficient remaining 
> uncertainties about the patch, it may be better to revert it before the 
> point release.

I think that the approach is still good. But the patch you've queued now
isn't going to be the one that ends up in blead.


Also, I've not re-tested my changes on older versions, so help there from
someone (not necessarily Dominic) would be welcome.

Nicholas Clark

Thread Previous


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