Jenda,

Thanks for your input, but I do believe I need to clear up some parts.

I use a semaphore for synchronizing between parent and child(s). The
semaphore starts with a initial value of, say 5 ( the maximum number of
child processes I want to handle simultaneously), and the parent process
wait() checkes to see if it is non-zero, and if so, decrements it by 1, and
continues.
If it is zero, it waits until it becomes non-zero. It is the responsibility
of the child proces to increment the semaphores value, indicating the
parent proces that it has ended. If the parent proces itself executes a
release(), it increments the semaphore! This would indicate that it can
continue, regardles of the number of childs actually spawned.

I tried your edited version, and it indeed spawned all childs
simultaneously.

My knowledge about the bless() part isn't deep enough (yet) to understand
what you're meaning, but I do think this wil be helpfull.
I changed the code again, leaving out the wait() part for the child, and
the release for the parent, and voila... IT WORKED!!
So it must be the bless() part that does it.

Again, THANKS for your input.

Guus

Final code looks like followes:
=======================================================================================================
use strict;
use Win32::Semaphore;

use vars qw($sem $semchild);
$| = 1;
$SIG{CHLD} = sub {wait()};

sub test_sem();

exit test_sem();

#package EmptyClass;
#package main;

sub test_sem() {
     my ($pid, $initial, $maximum, $name, $wksta) = (0,5,5,'SEINPAAL','');
     my ($sec,$min,$hour);

#    Create counting semaphore for a maximum of  5 outstanding childs
#    each child decrements count with 1 at exit, enabling parent to spawn another
     $sem = Win32::Semaphore->new($initial,$maximum,$name);


     for (my $i = 1; $i < 25; $i++)  {
          $sem->wait(); #wait for semaphore to become available
          print "Spawning child for $i\n";
          $pid = fork;
          if ($pid == 0 ) { # Child
               bless $sem, "EmptyClass";
               die "cannot fork: $!" unless defined $pid;
               $semchild = Win32::Semaphore->open($name) or die "Cannot open semaphore 
$!";
               ($sec,$min,$hour,) = localtime(time);
               print sprintf("Child %d starts on %02i:%02i:%02i\n",$$, $hour, $min, 
$sec);
               for (my $j = 0; $j < 1000000; $j++)  {
                         # Do some work
                         my $k = $j / 2
               }
               ($sec,$min,$hour,) = localtime(time);
               print sprintf("Child %d ends on %02i:%02i:%02i\n",$$, $hour, $min, 
$sec);
               my ($inc, $prev) = (1);
               $semchild->release($inc,$prev) or die "Child $$ could not release 
semaphore : $^E";
               print "Child $$ released on $prev\n";
               exit;
          }
     }
}
=======================================================================================================






"Jenda Krynicky" <[EMAIL PROTECTED]>@listserv.ActiveState.com on 30/05/2001
14:48:21

Sent by:  [EMAIL PROTECTED]


To:   [EMAIL PROTECTED]
cc:   [EMAIL PROTECTED]

Subject:  Re: Win32::Semaphore question


> I'm trying to get some synchronisation working between several child
> processes, using a counting semaphore.
> Probably I'm doing something wrong, because I get errors when releasing
the
> semaphore, stating that the handle is invalid.
> Because the release works the first time, I think I must do something
with
> the inherited filehandles.

There are several problems with Win32::Semaphore and fork()ed
threads. And a few with your code.

1) The docs say that open() is a CLASS method, not an instance one.
And that is gives you an object as its return value.

So you should use it like this :

$semchild = Win32::Semaphore->open($name)
 or die "Cannot open semaphore $!";

So you should create the semaphore in the parent thread and then
create new objects with Win32::Semaphore->open($name) in the
children. AND DO NOT USE THE OBJECT CREATED IN THE PARENT FROM THE
CHILDREN.

Also for whatever reason the ->release() did not like $prev preset to
999. Leave it undefined.

2) Since the parent wait()s for the semaphore it should also
release() it. Otherwise you run out of semaphores pretty quickly.

3) You have to make sure your children will not call DESTROY() on the
semaphore object you created in the parent. It would then become
unusable even in the main thread !!!

The DESTROY() calles some Win32 API functions and of course since all
threads have the same Win32 API handle in the $sem object, it doesn't
matter which one calls the DESTROY().

Of course you can't
     undef $sem;
in the children since that would call the DESTROY().
You have to do it like this :
     bless $sem, "EmptyObjectNotDefinedAnywhere";
     undef $sem;

The first line unties the object from the Win32::Semaphore class so
the second may safely delete the perl part of it.

I'm sure you will need this hack in many other places with many other
object as well with fork()ed threads. Actualy you should do this each
time you create an object BEFORE fork(), but cannot allow more
threads to be able to actualy destroy the object.

The reason is that the perl part of the object was cloned (every
child has its own copy) but the external part (something the system
or the DLL keeps and you only point to it with a handle or pointer)
was NOT. So even if it might be safe to use the object it is NOT SAFE
TO DESTROY it.

The code should look something like this :

use Win32::Semaphore;
$sem = Win32::Semaphore->new($initial,$maximum,$name);

for (my $i = 1; $i < 25; $i++)  {
     $sem->wait();
     if (fork()) {
          #child
          bless $sem, "EmptyObjectNotDefinedAnywhere";
          undef $sem;
          $semchild = Win32::Semaphore->open($name) or die "Cannot open
semaphore $!";
          $semchild->wait(500) or die "Child $$ : Wait failed\n";
          ... do something
          $semchild->release();
          exit;
     } else {
          #parent
          $sem->release();
     }
}

Jenda

P.S.: Fixed version of your code is attached. Actualy I'd like to thank
you. I
did not notice this module could be used so easily to restrict the number
of
running children alive at a time.

P.P.S.: (for Sarathy) I believe some note about the DESTROY() problem and
possible solution should be part of perlfork(). I don't know how to write
it so
that it's understandable.

== [EMAIL PROTECTED] == http://Jenda.Krynicky.cz ==
: What do people think?
What, do people think?  :-)
             -- Larry Wall in <[EMAIL PROTECTED]>


use strict;
use Win32::Semaphore;

use vars qw($sem $semchild);

$SIG{CHLD} = sub {wait()};

sub test_sem();

exit test_sem();

#package EmptyClass;
#package main;

sub test_sem() {
     my ($pid, $initial, $maximum, $name, $wksta) = (0,5,5,'SEINPAAL','');
     my ($sec,$min,$hour);

#    Create counting semaphore for a maximum of  5 outstanding childs
#    each child decrements count with 1 at exit, enabling parent to spawn
another
     $sem = Win32::Semaphore->new($initial,$maximum,$name);


     for (my $i = 1; $i < 25; $i++)  {
          $sem->wait(); #wait for semaphore to become available
          print "Spawning child for $i\n";
          $pid = fork;
          if ($pid == 0 ) { # Child
               bless $sem, "EmptyClass";
               die "cannot fork: $!" unless defined $pid;
               $semchild = Win32::Semaphore->open($name) or die "Cannot
open semaphore $!";
               $semchild->wait(500) or die "Child $$ : Wait failed\n";
               ($sec,$min,$hour,) = localtime(time);
               print sprintf("Child %d starts on %02i:%02i:%02i\n",$$,
$hour, $min, $sec);
               for (my $j = 0; $j < 100000; $j++)  {
                         # Do some work
                         my $k = $j / 2
               }
               ($sec,$min,$hour,) = localtime(time);
               print sprintf("Child %d ends on %02i:%02i:%02i\n",$$, $hour,
$min, $sec);
               my ($inc, $prev) = (1);
#               $semchild->release() or die "Could not release semaphore :
$^E";
               $semchild->release($inc,$prev) or die "Child $$ could not
release semaphore : $^E";
               print "Child $$ released on $prev\n";
               exit;
          } else {
               my ($inc, $prev) = (1);
               $sem->release($inc,$prev) or die "Father could not release
semaphore : $^E";
          }
     }
}





_______________________________________________
ActivePerl mailing list
[EMAIL PROTECTED]
http://listserv.ActiveState.com/mailman/listinfo/activeperl

Reply via email to