Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

Parallel::ForkManager dies with "Free to wrong pool..."

by perlygapes (Sexton)
on Jun 14, 2018 at 17:23 UTC ( [id://1216649]=perlquestion: print w/replies, xml ) Need Help??

perlygapes has asked for the wisdom of the Perl Monks concerning the following question:

Greetings unto ye who dwell within The Monastic Perly Gates.

It behoves me to humbly submit veneration to pave my request for your manifold threaded blessings.

I, possessing the skill of just a babe, am only beginning my pilgrimage along the path to scriptic enlightenment.

I have had a vision...of the many process paths one can travel, likened unto a multiverse with a portal at the end of child process run-time, such as can bring together once again in a glorious familial union all the scalar objects of my data affection.

But alas, the children, having left the Edenic memory space, have begun to murder each other...and so I have decided to confuse their number bases to facilitate coexistence via the spreading of their names across file allocation table space.

Yet still they sub-routinely fight over scalar object control.

And lo, I see no answer, but for me to go down into the realm of my children to understand them, be like one of them, and see how they are treating each other's memory pool.

For that, I beseech ye: will ye abide in hopefully not-so-longsuffering to see peace amongst my process children?

As by now you may have prophesied, here is the scripture reading for today... taken from the NewTransmogrified Version:


(Edit1: (for the benefit of fellow perlgrims) added the_main_reason(); as per the Monastic Guidance of choroba.
#!/usr/bin/perl use 5.24.0; # Book, Chapter and Verse use strict; # the First Commandment use warnings; # the Second Commandment use Digest::MD5 qw(md5_hex); # identity and volition use Math::Prime::Util ':all'; # the Tempter # provides 'todigitstring' and 'fromdigits' # I believe this is the cause - at line 132 in GMP.pm: '_GMP_destr +oy();' use Parallel::ForkManager; # the Family Unit my $children = 5; my @children = ("Cain","Abel","Seth","Noah","Shem"); my $birthorder = 0; my $family = Parallel::ForkManager->new($children); the_main_reason(); sub the_main_reason { print "Forming $children children.\n"; BEGET: foreach my $child (@children) { $birthorder++; print "Today, I have begotten child $birthorder as $child\n"; $family->start($child) and next BEGET; if ($child =~ m/cain/i) { the_task_I_gave_cain_to_do("Cain"); } elsif ($child =~ m/abel/i) { the_task_I_gave_abel_to_do("Abel"); } elsif ($child =~ m/seth/i) { the_task_I_gave_seth_to_do("Seth"); } elsif ($child =~ m/noah/i) { the_task_I_gave_noah_to_do("Noah"); } elsif ($child =~ m/shem/i) { the_task_I_gave_shem_to_do("Shem"); } # enable some prayer print "\$family->finish on child $child\n"; $family->finish(0); } # my longsuffering print "\$family->wait_all_children() is waiting...\n"; $family->wait_all_children(); } # the_main_reason exit; ########################################################## # priestly duties ########################################################## sub the_task_I_gave_cain_to_do { my $worker = shift; print "$worker is working.\n"; my $harvest; # A large harvest offering from Cain my $unique_offering; # so we know whose and what transgressions th +is offering covers my %items_to_offer; for (1..100000) { $items_to_offer{$_} = "Something $worker will burn on the alte +r: " . rand(); } foreach my $item (sort keys %items_to_offer) { $harvest .= $items_to_offer{$item} . "\n"; } # here are 3 attempts at obtaining salvation for the child via an +acceptable sacrifice # needless to say, they can only provide temporary atonement, in t +he end death comes to the child # first offering attempt - fruit - seems acceptable, but fails to +atone in the end $unique_offering = todigitstring(fromdigits(md5_hex($harvest), 16) +, 36); # free to wrong pool - child ends up in the lake of fire # OR # second offering attempt - grain - same judgement in the end as a +bove # $unique_offering = sub{todigitstring(fromdigits(md5_hex($harvest) +, 16), 36); return;}; # free to wrong pool - child ends up in the lake of fire down +this path too # OR # third offering attempt does not even make it into liturgically a +cceptable syntax # $unique_offering = sub{lock(todigitstring(fromdigits(md5_hex($har +vest), 16), 36); return;)}; # the $harvest is 'put in the storehouse' and is uniquely identifi +ed # against the offerer with $unique_offering in the book of data li +fe return; } sub the_task_I_gave_abel_to_do { my $worker = shift; print "$worker is working.\n"; my $harvest; my $unique_offering; my %items_to_offer; for (1..100000) { $items_to_offer{$_} = "Something $worker will burn on the alte +r: " . rand(); } foreach my $item (sort keys %items_to_offer) { $harvest .= $items_to_offer{$item} . "\n"; } $unique_offering = todigitstring(fromdigits(md5_hex($harvest), 16) +, 36); # OR # $unique_offering = sub{todigitstring(fromdigits(md5_hex($harvest) +, 16), 36); return;}; # OR # $unique_offering = sub{lock(todigitstring(fromdigits(md5_hex($har +vest), 16), 36); return;)}; # the tithe is brought to the storehouse here return; } sub the_task_I_gave_seth_to_do { my $worker = shift; print "$worker is working.\n"; my $harvest; my $unique_offering; my %items_to_offer; for (1..100000) { $items_to_offer{$_} = "Something $worker will burn on the alte +r: " . rand(); } foreach my $item (sort keys %items_to_offer) { $harvest .= $items_to_offer{$item} . "\n"; } $unique_offering = todigitstring(fromdigits(md5_hex($harvest), 16) +, 36); # OR # $unique_offering = sub{todigitstring(fromdigits(md5_hex($harvest) +, 16), 36); return;}; # OR # $unique_offering = sub{lock(todigitstring(fromdigits(md5_hex($har +vest), 16), 36); return;)}; # the tithe is brought to the storehouse here return; } sub the_task_I_gave_noah_to_do { my $worker = shift; print "$worker is working.\n"; my $harvest; my $unique_offering; my %items_to_offer; for (1..100000) { $items_to_offer{$_} = "Something $worker will burn on the alte +r: " . rand(); } foreach my $item (sort keys %items_to_offer) { $harvest .= $items_to_offer{$item} . "\n"; } $unique_offering = todigitstring(fromdigits(md5_hex($harvest), 16) +, 36); # OR # $unique_offering = sub{todigitstring(fromdigits(md5_hex($harvest) +, 16), 36); return;}; # OR # $unique_offering = sub{lock(todigitstring(fromdigits(md5_hex($har +vest), 16), 36); return;)}; # the tithe is brought to the storehouse here return; } sub the_task_I_gave_shem_to_do { my $worker = shift; print "$worker is working.\n"; my $harvest; my $unique_offering; my %items_to_offer; for (1..100000) { $items_to_offer{$_} = "Something $worker will burn on the alte +r: " . rand(); } foreach my $item (sort keys %items_to_offer) { $harvest .= $items_to_offer{$item} . "\n"; } $unique_offering = todigitstring(fromdigits(md5_hex($harvest), 16) +, 36); # OR # $unique_offering = sub{todigitstring(fromdigits(md5_hex($harvest) +, 16), 36); return;}; # OR # $unique_offering = sub{lock(todigitstring(fromdigits(md5_hex($har +vest), 16), 36); return;)}; # the tithe is brought to the storehouse here return; }

Below is the 'real' output from a parallel universe...I know, a bad pun:

("c:12" is just an optional MAX_CHILD argument)

Some inter-verse translation:
Running 5 threads. => print "Forming $children children.\n";
Thread N running for XX => print "Today, I have begotten child $birthorder as $child\n";
Starting XX under process id -NNNN => print "$worker is working.\n";

I thought I was looking through the Windows of seven (oh, boy, that's a bad one!), but I think they are Windows of leaven and hell...

user@computer C:\Users\user >perl C:\Users\user\eclipse-workspace\Crunchy\Generate_Mergatroidians. +pl c:12 Running script: C:\Users\user\eclipse-workspace\Crunchy\Generate_Merga +troidians.pl Running 5 threads. Thread 1 running for PR Starting PR under process id -4336 Thread 2 running for PT Starting PT under process id -4140 Thread 3 running for SS Starting SS under process id -1976 Thread 4 running for AR Starting AR under process id -2540 Thread 5 running for FO Starting FO under process id -1352 $obfuscation->wait_all_children() is waiting... $obfuscation->finish on child PT Free to wrong pool 34817a0 not 5e7460 at C:/Perl64/lib/Math/Prime/Util +/GMP.pm line 132. user@computer C:\Users\user >

The short of it is this:
All children appear to play 'together' nicely until the first one has finished and wants to go home to mummy...then it kill's all children and someone goes into the lake of fire (totally the wrong pool).
Here is The Question: how can I call a non-threadsafe module sub from multiple parallel spawned child threads in a way that none of them, or the called module, cause this amnesia?
The second is likened unto the first: do I need to lock these calls, and if so how do I lock them?
I have searched heaven and hell for the answer, but Google, though laughing in the stand, is not confessing...

...in faithful gratitude...

Replies are listed 'Best First'.
Re: Parallel::ForkManager dies with "Free to wrong pool..."
by dave_the_m (Monsignor) on Jun 14, 2018 at 20:19 UTC
    how can I call a non-threadsafe module sub from multiple parallel spawned child threads
    There are no guarantees of course, but you're likely to have better results if you 'require' the problematic module within each child thread/process, rather than use/requiring it in the parent process - which causes its data to be copied to each child via thread cloning (which is how fork() is implemented on Windows perl).

    Dave.

      Davidic counsel has borne scriptural truth.

      According to thy wisdom, I crucified

      use Digest::MD5 qw(md5_hex); use Math::Prime::Util ':all'; ... $unique_offering = todigitstring(fromdigits(md5_hex($harvest), 16), 36 +);

      and resurrected
      $unique_offering = sub { require Digest::MD5; require Math::Prime::Util; return Math::Prime::Util->todigitstring( Math::Prime::Util->fromdigits( Digest::MD5->md5_hex($harvest), 16), 36); };

      Lo, and behold, as you spake, so it came to pass...

      My humble thanks to you.

      And many thanks to you too, Sir!

      After all my meditations, I began to wonder if it should be required by each child instead.

      I will take your sage advice and apply it in faith.

      I bid thee, wouldest thou consider my supplication one more time?

      Oh my children, what shall I do?

      It seems I was presumptuous - it transpires my children have gone from killing each other to becoming pharasees, religiously quoting scriptural CODE(0xHHHHHH) references without following or understanding the purpose of my anonymous subroutine I assigned them

      This:

      $unique_offering = sub { require Digest::MD5; require Math::Prime::Util; return Math::Prime::Util->todigitstring( Math::Prime::Util->fromdigits( Digest::MD5->md5_hex($harvest), 16), 36); };

      now produces this:

      $unique_harvest # "CODE(0xHHHHHH)"

      I desire self expressions of love, not robots...
      I have studied the scriptures of other faiths, but I have not found any answers :-/

      What do ye advise?
Re: Parallel::ForkManager dies with "Free to wrong pool..."
by choroba (Cardinal) on Jun 14, 2018 at 20:22 UTC
    Running your script doesn't fail, but it doesn't output anything either. You probably transmogrified it too much. When I added
    the_main_reason();

    the script started to output something, but I wasn't able to make it fail. Setting $children to 12 didn't make it fail, either (I ran the script 50 times). But I'm on Linux, so there are no threads involved. See also SSCCE on how to provide a good question to which we can answer.

    ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord }map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,

      Many thanks for your reply!

      I am very grateful. And thank you for reminding me about the_main_reason().
      That got lost in transmogrification :)

      As for it working (after re-instating the main purpose) I tried to provide a contextually complete passage so I am not surprized it works. I have laboured many hours scribing it...

      I expected it would run without transgression on hallowed Linux ground...alas, I am locked into looking through Windoze because each child in the real script calls a single axe Windows executioner...with a black bag over his head and who cannot be reasoned with (he is ' Rushin' ').

      (I haven't tried Wine...only real wine :) )

      I could add a print statement in each subroutine to simply print the $unique_offering.

      But the part that breaks I included: The Tempter (Math::Prime::Util->subs)

      Edit: Temper => Tempter

Re: Parallel::ForkManager dies with "Free to wrong pool..."
by marioroy (Prior) on Jun 15, 2018 at 13:00 UTC

    Greetings perlygapes,

    Here is a version using MCE::Hobo. Workers may exit gracefully on Unix platforms to ease non-thread safe module(s) and possibly dependencies. Internally, MCE::Hobo sets the base generator uniquely between workers. Also for Math::Prime::Util and Math::Random.

    #!/usr/bin/perl use 5.24.0; # Book, Chapter and Verse use strict; # the First Commandment use warnings; # the Second Commandment use Digest::MD5 qw(md5_hex); # identity and volition use Math::Prime::Util ':all'; # the Tempter # provides 'todigitstring' and 'fromdigits' use MCE::Hobo; # the Family Unit my @children = ("Cain","Abel","Seth","Noah","Shem"); my $children = 5; my $birthorder = 0; # Set max_workers to limit # of workers running simultaneously. # Set posix_exit to avoid all END and destructor processing # inside the worker (ignored on the Windows platform). MCE::Hobo->init( max_workers => $children, posix_exit => 1 ); the_main_reason(); sub the_main_reason { printf "Forming $children children.\n"; foreach my $child (@children) { $birthorder++; print "Today, I have begotten child $birthorder as $child\n"; MCE::Hobo->create("begotten_child", $child) } # my longsuffering print "Waiting on begotten childen...\n"; MCE::Hobo->waitall(); } # the_main_reason sub begotten_child { my ($child) = @_; if ($child =~ m/cain/i) { the_task_I_gave_cain_to_do("Cain"); } elsif ($child =~ m/abel/i) { the_task_I_gave_abel_to_do("Abel"); } elsif ($child =~ m/seth/i) { the_task_I_gave_seth_to_do("Seth"); } elsif ($child =~ m/noah/i) { the_task_I_gave_noah_to_do("Noah"); } elsif ($child =~ m/shem/i) { the_task_I_gave_shem_to_do("Shem"); } # enable some prayer print "Child $child exiting\n"; MCE::Hobo->exit(0); } # begotten_child exit; ...

    Regards, Mario

      Received with thanks, Mario.
      I will come back to commune with this if later I need to.
      My script is now working, but I note that this module uses POSIX exits.
      Whilst I do not yet understand what exactly the difference is, I am aware it behaves differently.
      OK, coming back to this from my other question regarding PostgreSQL, I am running this on Windows and you mention that Windows ignores the POSIX exit.
      Can you tell me how this should change to run successfully on Windows?

      Thank you.

        Hi perlygapes,

        No changes needed on the Windows platform. The Hobo script in the prior post works. Append the script with the missing subroutines found here.

        sub the_task_I_gave_cain_to_do { ... } sub the_task_I_gave_abel_to_do { ... } sub the_task_I_gave_seth_to_do { ... } sub the_task_I_gave_noah_to_do { ... } sub the_task_I_gave_shem_to_do { ... }

        Output from Strawberry Perl 5.30.1:

        Forming 5 children. Today, I have begotten child 1 as Cain Today, I have begotten child 2 as Abel Cain is working. Today, I have begotten child 3 as Seth Abel is working. Today, I have begotten child 4 as Noah Seth is working. Today, I have begotten child 5 as Shem Noah is working. Waiting on begotten childen... Shem is working. Child Cain exiting

        Regards, Mario

Re: Parallel::ForkManager dies with "Free to wrong pool..."
by sundialsvc4 (Abbot) on Jun 15, 2018 at 13:29 UTC

    Since the exception appears to be being thrown within Math::Prime::Util::GMP, this becomes my prime suspect.   Looking at line 132 on "metacpan.org," I see that it is call to _GMP_destroy() and that it occurs within an END block.   This source-code in turn can be found at https://github.com/danaj/Math-Prime-Util-GMP/blob/master/gmp_main.c.

    My hypothesis now becomes that GMP, itself, is not thread/process safe.   That the actual root cause of your problem does not lie in your Perl code, but in the C-language implementation of GMP.   Of course this might be caused by some interaction with Perl’s implementation of threading, and/or with precisely what happens in an END-block, but the next experiment that I would perform is to cobble-up a C-language program that launches a number of C-language child processes to see if you can replicate the problem outside of the Perl environment.   I did not see any open or closed issues either on MetaCpan or GitHub that specifically talked about threading/process issues, but I don’t know how often the users of this package routinely attempt to use it that way.

    Exploring the source-code for the term “memory,” I stumbled upon a reference in expr.c to an external, mp_get_memory_functions(), which is probably one step closer to the actual way that GMP does memory management.   If there is anything buried in the bowels of this thing which needs a mutex in a multi-process environment, this would be more than sufficient to cause a problem like this and to make it thoroughly unpredictable.   Perl would now be exonerated – and, I suspect, it is.

      I give thanks for your answer to my supplications, sundialsvc4.
      I chant in unity with every utterance you have scribed.
      Indeed, mine own diligent study of scriptural truth did lead me to the very same line in the very same file.
      At this point I became aware of the true nature of this fallen state, and the need for a new plan of salvation for my children.
      The need to put something inside each child in order to inoculate it from ultimate death.

      As for GMP.pm...another plan of salvation is needed, one I cannot provide in this instantiated perl-verse

      A reply falls below the community's threshold of quality. You may see it by logging in.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://1216649]
Approved by Discipulus
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others sharing their wisdom with the Monastery: (7)
As of 2024-03-29 09:13 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found