in reply to Re^4: Why won't this Deadlock?
in thread Why won't this Deadlock?

Hi Jambo,

Incrementing a shared value (++) involves FETCH and STORE meaning two IPC trips behind the scene. It becomes more expensive for deeply-shared structures. I see the reason for wanting 3 mutexes to control which one goes first. However, having many mutexes may likely behave similarly to running without any mutex when involving multiple IPC trips.

# 3 IPC trips:  FETCH, FETCH, STORE
$t{$name}->{r}++;

# 6 IPC trips: FETCH, FETCH, FETCH, FETCH, FETCH, STORE
$t{index}->{ $t{prev} }{ $t{cur} }++;

[download]

Another possibility is 1-level shared-hash with compounded key names.

# 2 IPC trips: FETCH, STORE
$t{ "$name-rg" }++;

# 4 IPC trips: FETCH, FETCH, FETCH, STORE
my $prev = $t{prev};
my $cur  = $t{cur};
$t{ "index-$prev-$cur" }++;

[download]

To resolve the mis-counting issue, I constructed another mutex named $mutex and wrapped the operations inside it.

my $mutex  = Mutex->new;
...

my $rg = sub {
    my $name = shift || die;
    print "(rg)" if ( $name eq "fork1" );
    print "[rg]" if ( $name eq "fork2" );

    $mutex->enter( sub {
        $t{$name}->{r}++;
        $t{$name}->{rg}++;
        $t{$name}->{g}++;

        $t{cur} = "rg";
        $t{index}->{ $t{prev} }{ $t{cur} }++;
        $t{prev} = "rg";
    });

    $sleep_inside->();
};

my $ry = sub {
    my $name = shift || die;
    print "(ry)" if ( $name eq "fork1" );
    print "[ry]" if ( $name eq "fork2" );

    $mutex->enter( sub {
        $t{$name}->{r}++;
        $t{$name}->{ry}++;
        $t{$name}->{y}++;

        $t{cur} = "ry";
        $t{index}->{ $t{prev} }{ $t{cur} }++;
        $t{prev} = "ry";
    });

    $sleep_inside->();
};

my $rgy = sub {
    my $name = shift || die;
    say "{rgy}" if ( $name eq "mothersbaugh" );

    $mutex->enter( sub {
        $t{$name}->{r}++;
        $t{$name}->{rg}++;
        $t{$name}->{g}++;
        $t{$name}->{gy}++;
        $t{$name}->{rgy}++;

        $t{cur} = "rgy";
        $t{index}->{ $t{prev} }{ $t{cur} }++;
        $t{prev} = "rgy";
    });

    $sleep_inside->();
};

[download]

Here's an optimized version to rid of the extra mutex. It runs about 6 times faster over the original code. I've made a custom hash package based on MCE::Shared::Hash. Calling the OO method pipeline_eval sends a list of actions to the shared-manager to perform, where the data resides.

In essense, what this does is removes the deeply-sharing aspect from the picture. Only the outer-most hash is shared. The commands for updating the hash are combined and sent via 1 IPC call.

$ diff orig.pl script.pl
2a3,19
> package My::Hash;
>
> use MCE::Shared::Hash;
> use base 'MCE::Shared::Hash';
>
> sub pipeline_eval {
>    my $self = shift;
>    local $_ = $self;
>    while ( @_ ) {
>       eval shift->[0];
>    }
>    return;
> }
>
> 1;
>
> package main;
>

70c87
< tie my %t, 'MCE::Shared';
---
> tie my %t, 'MCE::Shared', { module => 'My::Hash' };

91,97c108,115
<     $t{$name}->{r}++;
<     $t{$name}->{rg}++;
<     $t{$name}->{g}++;
<
<     $t{cur} = "rg";
<     $t{index}->{ $t{prev} }{ $t{cur} }++;
<     $t{prev} = "rg";
---
>     tied( %t )->pipeline_eval(
>        [ "\$_->{ $name }->{r }++" ],
>        [ "\$_->{ $name }->{rg}++" ],
>        [ "\$_->{ $name }->{g }++" ],
>        [ "\$_->{ cur   } = 'rg'"  ],
>        [ "\$_->{ index }->{ \$_->{ prev } }{ \$_->{ cur } }++" ],
>        [ "\$_->{ prev  } = 'rg'"  ]
>     );

107,113c125,132
<     $t{$name}->{r}++;
<     $t{$name}->{ry}++;
<     $t{$name}->{y}++;
<
<     $t{cur} = "ry";
<     $t{index}->{ $t{prev} }{ $t{cur} }++;
<     $t{prev} = "ry";
---
>     tied( %t )->pipeline_eval(
>        [ "\$_->{ $name }->{r }++" ],
>        [ "\$_->{ $name }->{ry}++" ],
>        [ "\$_->{ $name }->{y }++" ],
>        [ "\$_->{ cur   } = 'ry'"  ],
>        [ "\$_->{ index }->{ \$_->{ prev } }{ \$_->{ cur } }++" ],
>        [ "\$_->{ prev  } = 'ry'"  ]
>     );

123,131c142,151
<     $t{$name}->{r}++;
<     $t{$name}->{rg}++;
<     $t{$name}->{g}++;
<     $t{$name}->{gy}++;
<     $t{$name}->{rgy}++;
<
<     $t{cur} = "rgy";
<     $t{index}->{ $t{prev} }{ $t{cur} }++;
<     $t{prev} = "rgy";
---
>     tied( %t )->pipeline_eval(
>        [ "\$_->{ $name }->{r  }++" ],
>        [ "\$_->{ $name }->{rg }++" ],
>        [ "\$_->{ $name }->{g  }++" ],
>        [ "\$_->{ $name }->{gy }++" ],
>        [ "\$_->{ $name }->{rgy}++" ],
>        [ "\$_->{ cur   } = 'rgy'"  ],
>        [ "\$_->{ index }->{ \$_->{ prev } }{ \$_->{ cur } }++" ],
>        [ "\$_->{ prev  } = 'rgy'"  ]
>     );

[download]

Below is the dump output from perl script.pl --iterations=5000 --stats=1

$VAR1 = {
          'cur' => 'ry',
          'index' => {
                       'ry' => {
                                 'rg' => 4035,
                                 'rgy' => 2471,
                                 'ry' => 3493
                               },
                       'rgy' => {
                                  'rg' => 2480,
                                  'ry' => 2496,
                                  'rgy' => 24
                                },
                       'rg' => {
                                 'rg' => 3485,
                                 'rgy' => 2504,
                                 'ry' => 4011
                               },
                       'null' => {
                                   'rgy' => 1
                                 }
                     },
          'starttime' => 1499832324,
          'fork2' => {
                       'rg' => 5000,
                       'ry' => 5000,
                       'r' => 10000,
                       'g' => 5000,
                       'y' => 5000
                     },
          'prev' => 'ry',
          'mothersbaugh' => {
                              'rgy' => 5000,
                              'gy' => 5000,
                              'rg' => 5000,
                              'r' => 5000,
                              'g' => 5000
                            },
          'fork1' => {
                       'r' => 10000,
                       'g' => 5000,
                       'y' => 5000,
                       'rg' => 5000,
                       'ry' => 5000
                     }
        };

[download]

Update:

After running, the overhead of the shared-variable isn't needed. Therefore, export the shared hash into a normal hash. Optionally, untie the shared hash.

  # print Dumper( tied(%t)->export( { unbless => 1 } ) ) if ($STATS);

    my %h = %{ tied(%t)->export({ unbless => 1 }) };  untie %t;
    print Dumper(\%h) if $STATS;

[download]

Regards, Mario

Replies are listed 'Best First'.
Re^6: Why won't this Deadlock?
by Jambo Hamon (Novice) on Jul 12, 2017 at 11:41 UTC
    Hi Mario,

    The pipeline_eval sub is awesome. Exactly what I was thinking about.

    There is a document that shows that ' can be used in place of :: for package separators. 

    perldoc perlmod 
http://perltricks.com/article/obscure-perl-trick--single-quote-separat
+ors/

    [download]
    Here's a test for correctness of the MCE'*:

    Can MCE'* clone itself into MCE'MCE'* ?
    Or in a similar way MCE'MCE'MCE'*

    Sorry if I was rude last night. I was blitz'ed

    Packages are just GLOBS right, so it should be possible to share everything, from the __PACKAGE__ quite easily.

    This is the English version and has the famous last words:

    Coming up with the some code in a few hours to show MCE'* is Genius.

    Cheers,
    James PS. Here is a small diff that moves use strict; use warnings; to the start of the file. 

    2,4d1
< use strict;
< use warnings;
< use v5.20;    # oh yeah
7d3
< 
22c18,20
< 
---
> use strict;
> use warnings;
> use v5.20;    # oh yeah

    [download]
[reply]
[d/l]
[select]
Re^6: Why won't this Deadlock?
by Jambo Hamon (Novice) on Jul 12, 2017 at 19:19 UTC

    It's a display model, it doesn't work the way it's intended to (yet!). 

    #!/usr/bin/perl
use strict;
use warnings;
use v5.20;    # oh yeah

package Stash;

# Stash = Symbol Table Hash

sub steal {

    # hosed logic here
    #my ($from, $to) = @_ || ( shift || 'main', (caller)[0] );
    my ( $from, $to ) = @_;

    no strict 'refs';

    return map {
        s/\\/\\\\/;
        qq!\$_->{$$}{'$_'} = qq|*{'${to}::$_'} = *{'${from}::$_'}| !
    } keys %{"${from}::"};
}

1;

package My::Hash;

use MCE::Shared::Hash;
use base 'MCE::Shared::Hash';

sub pipeline_eval {
    my $self = shift;
    local $_ = $self;
    while (@_) {

        #say " eval ", shift->[0];
        eval shift->[0];
    }
    return;
}
1;

package main;

use Data::Dumper;
use MCE::Shared;

tie my %t, 'MCE::Shared', { module => 'My::Hash' };

tied(%t)->pipeline_eval(
    map { [$_] } Stash::steal( "main", "My::Hash" )    # steal from, t
+o
);

print Dumper( tied(%t)->export( { unbless => 1 } ) );

    [download]
[reply]
[d/l]

      Hi Jambo Hamon,

      I'm afraid that MCE::Shared may not support the things you'd like to do with it. The reason is that serialization may fail depending on what's inside the package / hash. From reviewing the code, $_-> must be backslashed \$_-> near the beginning of each string for pipeline_eval to work.

      Regards, Mario

[reply]

In Section Seekers of Perl Wisdom