Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

Reusable threads demo

by zentara (Archbishop)
on Jun 12, 2008 at 19:45 UTC ( [id://691785]=perlmeditation: print w/replies, xml ) Need Help??

A few recent nodes could be solved by reusable threads. All my examples were for Tk or Gtk2, so this is a pure commandline demonstration. It starts 10 reusable threads as a pool, and cycles thru the alphabet. Each thread will pick up a letter, and count to 10 with it( with random time intervals). When done a thread is made available for reuse, and this continues until the data(alphabet) is exhausted and all threads finish. It's not perfect. I use some goto's to break out of nested loops, and some other acrobatics. :-) If anyone can see how to avoid the goto's, with the same clarity, please post it. :-)

This concept is useful when you have objects in your threads which are not totally threadsafe. Reusing threads will usually save some memory gains often associated with creating/destroying/creating threads.

I tried to keep it as simple as possible, so a new threads user can see what is happening.

#!/usr/bin/perl use strict; use warnings; use threads; use threads::shared; my %shash; my @to_be_processed = ('a'..'z'); my @ready:shared = (); my $numworkers = 10; foreach my $dthread(1..$numworkers){ share $shash{$dthread}{'go'}; $shash{$dthread}{'go'} = 0; share $shash{$dthread}{'fileno'}; #in case you want $shash{$dthread}{'fileno'} = ''; #shared filehandles share $shash{$dthread}{'data'}; $shash{$dthread}{'data'} = ''; share $shash{$dthread}{'pid'}; $shash{$dthread}{'pid'} = -1; share $shash{$dthread}{'die'}; $shash{$dthread}{'die'} = 0; $shash{$dthread}{'thread'} = threads->new(\&worker, $dthread); push @ready, $dthread; } print "\t\t",scalar @ready," threads ready.......press a key to start +threads\n"; <>; while (my $t = shift(@ready)){ $shash{$t}{'data'} = shift @to_be_processed; $shash{$t}{'go'} = 1; } while(1){ if( scalar @ready > 0 ){ if( my $data = shift @to_be_processed ){ my $t = shift(@ready); $shash{$t}{'data'} = $data; $shash{$t}{'go'} = 1; print "thread $t restarting\n"; }else{ print "out of input\n"; goto WAIT; } } } WAIT: print "\n\n\nWAITING FOR FINISH\n\n\n"; while(1){ print "\n\n\n",scalar @ready," are ready\n\n\n"; if ( scalar @ready < $numworkers ){ sleep 1}else{ foreach my $t(@ready){ $shash{$t}{'die'} = 1; $shash{$t}{'thread'}->join; print "joining thread $t\n"; } exit; } } sub worker{ my $thr_num = shift; print "$thr_num started\n"; #create your reusable objects here if needed my $count; START: while(1){ if( $shash{$thr_num}{'die'} ){ print "thread $thr_num finishing\n"; return} #wait for $go_control if($shash{$thr_num}{'go'}){ if($shash{$thr_num}{'die'}){ print "thread finishing\n"; return} $count++; my $str = ' 'x$thr_num; #printout spacer print $str.$thr_num.'->'.$count.$shash{$thr_num}{'data' +},"\n"; if ($count > 10){ goto RECYCLE; } #select(undef,undef,undef,.25); sleep rand 5 }else{ $count = 0; select(undef,undef,undef,.25); }# sleep until awakened } #end while(1) RECYCLE: $shash{$thr_num}{'go'} = 0; print "$thr_num done....going back to sleep\n"; $shash{$thr_num}{'data'} = ''; # clean out temp data from objects here, if needed # see "perldoc -q clear" $count = 0; push @ready, $thr_num; print "pushing $thr_num\n"; goto START; return; }

Replies are listed 'Best First'.
Re: Reusable threads demo
by TGI (Parson) on Jun 13, 2008 at 17:25 UTC

    zentara, thanks for yet another great worker thread example. ++. I'm pretty sure you know the techniques I use below. I hope that my alternate, goto-less approach is useful to someone.

    It's possible to get rid of the gotos. I don't know that it improves readability/maintainability. I like the way that the gotos work to jump out of the loop in the original.

    On with the code. Removing the first goto:

    PROCESS_DATA: while(1){ if( scalar @ready > 0 ){ if( my $data = shift @to_be_processed ){ my $t = shift(@ready); $shash{$t}{'data'} = $data; $shash{$t}{'go'} = 1; print "thread $t restarting\n"; }else{ print "out of input\n"; last PROCESS_DATA; } } } # end PROCESS_DATA

    I used last to break out of the loop. I added a label to retain the readability of the goto version. It's functionally equivalent to the goto version.

    Now the second and third goto:

    sub worker{ my $thr_num = shift; print "$thr_num started\n"; my $count; while(1) { WORKER_LOOP: while(1){ if( $shash{$thr_num}{'die'} ){ print "thread $thr_num finishing\n"; return} #wait for $go_control if($shash{$thr_num}{'go'}){ if($shash{$thr_num}{'die'}){ print "thread finishing\n"; return} $count++; my $str = ' 'x$thr_num; #printout spacer print $str.$thr_num.'->'.$count.$shash{$thr_num}{'data'}," +\n"; if ($count > 10){ last WORKER_LOOP; } #select(undef,undef,undef,.25); sleep rand 5 }else{ $count = 0; select(undef,undef,undef,.25); }# sleep until awakened } #end WORKER_LOOP # Recycle Thread $shash{$thr_num}{'go'} = 0; print "$thr_num done....going back to sleep\n"; $shash{$thr_num}{'data'} = ''; $count = 0; push @ready, $thr_num; print "pushing $thr_num\n"; } return; }

    I wrapped the section bracketed by the START label and goto START with a loop. I didn't label the loop, because we never break it. It may make sense to apply a label here in some instances.

    I added a label to the pre-existing loop (now an inner loop), and use last to break out of it as needed. Once again, to improve readability, I used a label where it isn't necessary.

    Whether these changes are worth making, I can't say for sure. I tend to prefer the inner/outer loop arrangement I show above to zentara's loop implemented as a goto, simply because I can bounce between the enclosing brackets with my % key. I like the other gotos, and feel that they do help readability. YMMV.


    TGI says moo

      Thanks for that. I suppose which style is used by someone will depend on the type of work the threads do. Usually it isn't as simple as this example. I would use your method, because of it's clean style; but I would keep the goto in my back pocket for emergency use. :-)

      I'm not really a human, but I play one on earth CandyGram for Mongo
Re: Reusable threads demo
by marioroy (Prior) on May 11, 2018 at 02:13 UTC

    Hi zentara,

    Found this thread via your mention of it here. I'm providing a demonstration for Perl lacking threads support. Perl with threads support may run MCE::Shared as well. Simply replace MCE::Hobo with threads. I went completely OO with the shared objects for minimum overhead.

    #!/usr/bin/perl use strict; use warnings; use MCE::Hobo; use MCE::Shared; my %shash; my @to_be_processed = ('a'..'z'); my $ready = MCE::Shared->array; my $numworkers = 10; foreach my $dthread(1..$numworkers){ $shash{$dthread}{'go'} = MCE::Shared->scalar( 0); $shash{$dthread}{'fileno'} = MCE::Shared->scalar(''); #in case you want shared filehandles $shash{$dthread}{'data'} = MCE::Shared->scalar(''); $shash{$dthread}{'pid'} = MCE::Shared->scalar(-1); $shash{$dthread}{'die'} = MCE::Shared->scalar( 0); $shash{$dthread}{'thread'} = MCE::Hobo->new(\&worker, $dthread); $ready->push($dthread); } print "\t\t",$ready->len," threads ready.......press a key to start th +reads\n"; <>; while (my $t = $ready->shift){ $shash{$t}{'data'}->set(shift @to_be_processed); $shash{$t}{'go'}->set(1); } while(1){ if( $ready->len > 0 ){ if( my $data = shift @to_be_processed ){ my $t = $ready->shift; $shash{$t}{'data'}->set($data); $shash{$t}{'go'}->set(1); print "thread $t restarting\n"; }else{ print "out of input\n"; goto WAIT; } } } WAIT: print "\n\n\nWAITING FOR FINISH\n\n\n"; while(1){ print "\n\n\n",$ready->len," are ready\n\n\n"; if( $ready->len < $numworkers ){ sleep 1; }else{ foreach my $t ( $ready->vals ){ $shash{$t}{'die'}->set(1); $shash{$t}{'thread'}->join; print "joining thread $t\n"; } exit; } } sub worker{ my $thr_num = shift; print "$thr_num started\n"; #create your reusable objects here if needed my $count; START: while(1){ if( $shash{$thr_num}{'die'}->get() ){ print "thread $thr_num finishing\n"; return } #wait for $go_control if( $shash{$thr_num}{'go'}->get() ){ if( $shash{$thr_num}{'die'}->get() ){ print "thread finishing\n"; return } $count++; my $str = ' 'x$thr_num; #printout spacer print $str.$thr_num.'->'.$count.$shash{$thr_num}{'data'}-> +get(),"\n"; if( $count > 10 ){ goto RECYCLE; } #select(undef,undef,undef,.25); sleep rand 5 }else{ $count = 0; select(undef,undef,undef,.25); } #sleep until awakened } #end while(1) RECYCLE: $shash{$thr_num}{'go'}->set(0); print "$thr_num done....going back to sleep\n"; $shash{$thr_num}{'data'}->set(''); #clean out temp data from objects here, if needed #see "perldoc -q clear" $count = 0; $ready->push($thr_num); print "pushing $thr_num\n"; goto START; return; }

    Regards, Mario

      Another nice example for the MCE::Hobo Cookbook. :-) Thanks.

      I'm not really a human, but I play one on earth. ..... an animated JAPH
Re: Reusable threads demo
by JoeKamel (Acolyte) on Aug 19, 2008 at 19:32 UTC
    Zentara,

    Sorry to be "that guy", but you gave me the power, and with great power....should come jelly beans...or something like that.

    Anyway, depending on what folks do with this code, there is a potential infinite loop here:
    while (my $t = shift(@ready)){ $shash{$t}{'data'} = shift @to_be_processed; $shash{$t}{'go'} = 1; }

    if you have enough threads that this loop isn't finished by the time the earliest threads are starting, then the worker will push threads back into the @ready list. In my case (as i just found out), it takes about ~130 threads to get to this point. Granted, in this example the loop will be done soon since the to be processed list is pretty short, but depending on what folks do with your example, this may not be the case. So, this probably isn't a general problem, but still.

    Luckily, its easily solved (otherwise I'd be asking questions again). change the init loop to look like:

    my @tready = @ready; @ready(); while (my $t = shift(@tready)){ $shash{$t}{'data'} = shift @to_be_processed; $shash{$t}{'go'} = 1; }

    Hopefully this will be useful to the next madman that comes along

      We stand on the shoulders of the madmen who preceeded us, and hope they left us a stash of jellybeans. In reality, I would say that if you have an app hitting 130 threads, you may need a design adjustment, or switch to c. :-)

      I'm not really a human, but I play one on earth Remember How Lucky You Are
Re: Reusable threads demo
by snigavig (Initiate) on Aug 17, 2012 at 13:39 UTC
    Can someone help me a bit? What if @to_be_processed is not an array of symbols but an array of hashes, how should this look like?
    share $shash{$dthread}{'data'}; $shash{$dthread}{'data'} = '';
      Hi, unless the threads::shared model has improved a bit lately, you can only pass scalars as shared variables, and when you share a hash, only the top level hash keys can be accessed. So if you try to descend into a shared hashref, you may get bad results on a deep hash. See threads::shared and if you can show a running code example of what you are doing, that would help everyone out.

      I'm not really a human, but I play one on earth.
      Old Perl Programmer Haiku ................... flash japh
        Hello, I'm posting here what I did at that time, maybe it becomes handy to someone..:
        share $shash{$dthread}{'go'}; $shash{$dthread}{'go'} = 0; share $shash{$dthread}{'data'}->{'first_key'}; $shash{$dthread}{'data'}->{'first_key'} = ''; share $shash{$dthread}{'data'}->{'second_key'}; $shash{$dthread}{'data'}->{'second_key'} = ''; share $shash{$dthread}{'data'}->{'third_key'}; $shash{$dthread}{'data'}->{'third_key'} = ''; share $shash{$dthread}{'pid'}; $shash{$dthread}{'pid'} = -1; share $shash{$dthread}{'die'}; $shash{$dthread}{'die'} = 0;
        In such case $shash{$dthread}{'data'} becomes a key-value hash. Thank you!

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlmeditation [id://691785]
Front-paged by Arunbear
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others surveying the Monastery: (8)
As of 2024-04-18 09:21 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found