[ViewVC] Diff of: cvs/Coro/Coro.pm

Comparing Coro/Coro.pm (file contents):
Revision 1.132 by root, Thu Sep 20 22:53:23 2007 UTC vs.
Revision 1.144 by root, Wed Oct 3 01:48:05 2007 UTC

 our $idle;    # idle handler
 our $main;    # main coroutine
 our $current; # current coroutine
-our $VERSION = '3.7';
+our $VERSION = '4.0';
 our @EXPORT = qw(async async_pool cede schedule terminate current unblock_sub);
 our %EXPORT_TAGS = (
       prio => [qw(PRIO_MAX PRIO_HIGH PRIO_NORMAL PRIO_LOW PRIO_IDLE PRIO_MIN)],
 );
 =cut
 $main->{desc} = "[main::]";
 # maybe some other module used Coro::Specific before...
-$main->{specific} = $current->{specific}
+$main->{_specific} = $current->{_specific}
    if $current;
 _set_current $main;
 sub current() { $current }
    # free coroutine data and mark as destructed
    $self->_destroy
       or return;
    # call all destruction callbacks
-   $_->(@{$self->{status}})
+   $_->(@{$self->{_status}})
-      for @{(delete $self->{destroy_cb}) || []};
+      for @{(delete $self->{_on_destroy}) || []};
 }
 # this coroutine is necessary because a coroutine
 # cannot destroy itself.
 my @destroy;
 The pool size is limited to 8 idle coroutines (this can be adjusted by
 changing $Coro::POOL_SIZE), and there can be as many non-idle coros as
 required.
 If you are concerned about pooled coroutines growing a lot because a
-single C<async_pool> used a lot of stackspace you can e.g. C<async_pool {
+single C<async_pool> used a lot of stackspace you can e.g. C<async_pool
-terminate }> once per second or so to slowly replenish the pool.
+{ terminate }> once per second or so to slowly replenish the pool. In
+addition to that, when the stacks used by a handler grows larger than 16kb
+(adjustable with $Coro::POOL_RSS) it will also exit.
 =cut
 our $POOL_SIZE = 8;
-our $MAX_POOL_RSS = 64 * 1024;
+our $POOL_RSS  = 16 * 1024;
-our @pool;
+our @async_pool;
 sub pool_handler {
+   my $cb;
    while () {
-      $current->{desc} = "[async_pool]";
       eval {
-         my ($cb, @arg) = @{ delete $current->{_invoke} or return };
+         while () {
-         $cb->(@arg);
+            _pool_1 $cb;
+            &$cb;
+            _pool_2 $cb;
+            &schedule;
+         }
       };
+      last if $@ eq "\3terminate\2\n";
       warn $@ if $@;
-      last if @pool >= $POOL_SIZE || $current->rss >= $MAX_POOL_RSS;
-      push @pool, $current;
-      $current->{desc} = "[async_pool idle]";
-      $current->save (Coro::State::SAVE_DEF);
-      $current->prio (0);
-      schedule;
    }
 }
 sub async_pool(&@) {
    # this is also inlined into the unlock_scheduler
-   my $coro = (pop @pool) || new Coro \&pool_handler;;
+   my $coro = (pop @async_pool) || new Coro \&pool_handler;
    $coro->{_invoke} = [@_];
    $coro->ready;
    $coro
 =item terminate [arg...]
 Terminates the current coroutine with the given status values (see L<cancel>).
+=item killall
+Kills/terminates/cancels all coroutines except the currently running
+one. This is useful after a fork, either in the child or the parent, as
+usually only one of them should inherit the running coroutines.
 =cut
 sub terminate {
    $current->cancel (@_);
+}
+sub killall {
+   for (Coro::State::list) {
+      $_->cancel
+         if $_ != $current && UNIVERSAL::isa $_, "Coro";
+   }
 }
 =back
 # dynamic methods
 =cut
 sub cancel {
    my $self = shift;
-   $self->{status} = [@_];
+   $self->{_status} = [@_];
    if ($current == $self) {
       push @destroy, $self;
       $manager->ready;
       &schedule while 1;
 }
 =item $coroutine->join
 Wait until the coroutine terminates and return any values given to the
-C<terminate> or C<cancel> functions. C<join> can be called multiple times
+C<terminate> or C<cancel> functions. C<join> can be called concurrently
-from multiple coroutine.
+from multiple coroutines.
 =cut
 sub join {
    my $self = shift;
-   unless ($self->{status}) {
+   unless ($self->{_status}) {
       my $current = $current;
-      push @{$self->{destroy_cb}}, sub {
+      push @{$self->{_on_destroy}}, sub {
          $current->ready;
          undef $current;
       };
       &schedule while $current;
    }
-   wantarray ? @{$self->{status}} : $self->{status}[0];
+   wantarray ? @{$self->{_status}} : $self->{_status}[0];
 }
 =item $coroutine->on_destroy (\&cb)
 Registers a callback that is called when this coroutine gets destroyed,
 =cut
 sub on_destroy {
    my ($self, $cb) = @_;
-   push @{ $self->{destroy_cb} }, $cb;
+   push @{ $self->{_on_destroy} }, $cb;
 }
 =item $oldprio = $coroutine->prio ($newprio)
 Sets (or gets, if the argument is missing) the priority of the
 =item $olddesc = $coroutine->desc ($newdesc)
 Sets (or gets in case the argument is missing) the description for this
 coroutine. This is just a free-form string you can associate with a coroutine.
+This method simply sets the C<< $coroutine->{desc} >> member to the given string. You
+can modify this member directly if you wish.
 =cut
 sub desc {
    my $old = $_[0]{desc};
 # inside an event callback.
 our $unblock_scheduler = new Coro sub {
    while () {
       while (my $cb = pop @unblock_queue) {
          # this is an inlined copy of async_pool
-         my $coro = (pop @pool or new Coro \&pool_handler);
+         my $coro = (pop @async_pool) || new Coro \&pool_handler;
          $coro->{_invoke} = $cb;
          $coro->ready;
          cede; # for short-lived callbacks, this reduces pressure on the coro pool
       }

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing Coro/Coro.pm (file contents): Revision 1.132 by root, Thu Sep 20 22:53:23 2007 UTC vs. Revision 1.144 by root, Wed Oct 3 01:48:05 2007 UTC

Diff Legend

Comparing Coro/Coro.pm (file contents):
Revision 1.132 by root, Thu Sep 20 22:53:23 2007 UTC vs.
Revision 1.144 by root, Wed Oct 3 01:48:05 2007 UTC