--- Coro/Coro.pm 2007/09/20 22:53:23 1.132 +++ Coro/Coro.pm 2007/10/05 20:11:25 1.148 @@ -52,7 +52,7 @@ our $main; # main coroutine our $current; # current coroutine -our $VERSION = '3.7'; +our $VERSION = '4.01'; our @EXPORT = qw(async async_pool cede schedule terminate current unblock_sub); our %EXPORT_TAGS = ( @@ -118,7 +118,7 @@ $main->{desc} = "[main::]"; # maybe some other module used Coro::Specific before... -$main->{specific} = $current->{specific} +$main->{_specific} = $current->{_specific} if $current; _set_current $main; @@ -153,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 @@ -189,6 +189,9 @@ (usually unused). When the sub returns the new coroutine is automatically terminated. +See the C constructor for info about the coroutine +environment. + Calling C in a coroutine will do the same as calling exit outside the coroutine. Likewise, when the coroutine dies, the program will exit, just as it would in the main program. @@ -218,46 +221,50 @@ will not work in the expected way, unless you call terminate or cancel, which somehow defeats the purpose of pooling. -The priority will be reset to C<0> after each job, otherwise the coroutine -will be re-used "as-is". +The priority will be reset to C<0> after each job, tracing will be +disabled, the description will be reset and the default output filehandle +gets restored, so you can change alkl these. Otherwise the coroutine will +be re-used "as-is": most notably if you change other per-coroutine global +stuff such as C<$/> you need to revert that change, which is most simply +done by using local as in C< local $/ >. 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 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 $MAX_POOL_RSS = 64 * 1024; -our @pool; +our $POOL_RSS = 16 * 1024; +our @async_pool; sub pool_handler { - while () { - $current->{desc} = "[async_pool]"; + 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 || $current->rss >= $MAX_POOL_RSS; - push @pool, $current; - $current->{desc} = "[async_pool idle]"; - $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) || new Coro \&pool_handler;; + my $coro = (pop @async_pool) || new Coro \&pool_handler; $coro->{_invoke} = [@_]; $coro->ready; @@ -310,12 +317,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 @@ -333,7 +353,8 @@ called. To make the coroutine run you must first put it into the ready queue by calling the ready method. -See C for additional discussion. +See C and C for additional info about the +coroutine environment. =cut @@ -367,7 +388,7 @@ sub cancel { my $self = shift; - $self->{status} = [@_]; + $self->{_status} = [@_]; if ($current == $self) { push @destroy, $self; @@ -381,18 +402,18 @@ =item $coroutine->join Wait until the coroutine terminates and return any values given to the -C or C functions. C can be called multiple times -from multiple coroutine. +C or C functions. C can be called concurrently +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; }; @@ -400,7 +421,7 @@ &schedule while $current; } - wantarray ? @{$self->{status}} : $self->{status}[0]; + wantarray ? @{$self->{_status}} : $self->{_status}[0]; } =item $coroutine->on_destroy (\&cb) @@ -414,7 +435,7 @@ sub on_destroy { my ($self, $cb) = @_; - push @{ $self->{destroy_cb} }, $cb; + push @{ $self->{_on_destroy} }, $cb; } =item $oldprio = $coroutine->prio ($newprio) @@ -449,6 +470,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 { @@ -537,7 +561,7 @@ 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; @@ -575,7 +599,7 @@ =head1 SEE ALSO -Support/Utility: L, L, L, L. +Support/Utility: L, L, L. Locking/IPC: L, L, L, L, L.