--- Coro/Coro.pm 2007/05/26 15:33:25 1.126 +++ Coro/Coro.pm 2007/10/02 23:16:24 1.142 @@ -52,7 +52,7 @@ our $main; # main coroutine our $current; # current coroutine -our $VERSION = '3.63'; +our $VERSION = '3.8'; our @EXPORT = qw(async async_pool cede schedule terminate current unblock_sub); our %EXPORT_TAGS = ( @@ -115,8 +115,10 @@ =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; @@ -151,8 +153,8 @@ or return; # call all destruction callbacks - $_->(@{$self->{status}}) - for @{(delete $self->{destroy_cb}) || []}; + $_->(@{$self->{_status}}) + for @{(delete $self->{_on_destroy}) || []}; } # this coroutine is necessary because a coroutine @@ -168,7 +170,7 @@ &schedule; } }; - +$manager->desc ("[coro manager]"); $manager->prio (PRIO_MAX); # static methods. not really. @@ -224,34 +226,38 @@ required. If you are concerned about pooled coroutines growing a lot because a -single C used a lot of stackspace you can e.g. C once per second or so to slowly replenish the pool. +single C used a lot of stackspace you can e.g. C 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 @pool; +our $POOL_RSS = 16 * 1024; +our @async_pool; sub pool_handler { + my $cb; + while () { eval { - my ($cb, @arg) = @{ delete $current->{_invoke} or return }; - $cb->(@arg); + while () { + _pool_1 $cb; + &$cb; + _pool_2 $cb; + &schedule; + } }; - warn $@ if $@; - - last if @pool >= $POOL_SIZE; - push @pool, $current; - $current->save (Coro::State::SAVE_DEF); - $current->prio (0); - schedule; + last if $@ eq "\3terminate\2\n"; + warn $@ if $@; } } sub async_pool(&@) { # this is also inlined into the unlock_scheduler - my $coro = (pop @pool or new Coro \&pool_handler); + my $coro = (pop @async_pool) || new Coro \&pool_handler; $coro->{_invoke} = [@_]; $coro->ready; @@ -304,12 +310,25 @@ Terminates the current coroutine with the given status values (see L). +=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 @@ -361,7 +380,7 @@ sub cancel { my $self = shift; - $self->{status} = [@_]; + $self->{_status} = [@_]; if ($current == $self) { push @destroy, $self; @@ -383,10 +402,10 @@ 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; }; @@ -394,7 +413,7 @@ &schedule while $current; } - wantarray ? @{$self->{status}} : $self->{status}[0]; + wantarray ? @{$self->{_status}} : $self->{_status}[0]; } =item $coroutine->on_destroy (\&cb) @@ -408,7 +427,7 @@ sub on_destroy { my ($self, $cb) = @_; - push @{ $self->{destroy_cb} }, $cb; + push @{ $self->{_on_destroy} }, $cb; } =item $oldprio = $coroutine->prio ($newprio) @@ -443,6 +462,9 @@ 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 { @@ -527,11 +549,11 @@ # to reduce pressure on the coro pool (because most callbacks # return immediately and can be reused) and because we cannot cede # inside an event callback. -our $unblock_scheduler = async { +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; @@ -540,6 +562,7 @@ schedule; # sleep well } }; +$unblock_scheduler->desc ("[unblock_sub scheduler]"); sub unblock_sub(&) { my $cb = shift;