--- cvsroot/Coro/Coro.pm 2001/07/23 02:14:19 1.22 +++ cvsroot/Coro/Coro.pm 2001/08/11 19:59:19 1.30 @@ -26,25 +26,9 @@ This module is still experimental, see the BUGS section below. In this module, coroutines are defined as "callchain + lexical variables -+ @_ + $_ + $@ + $^W), that is, a coroutine has it's own callchain, it's -own set of lexicals and it's own set of perl's most important global -variables. - -WARNING: When using this module, make sure that, at program end, no -coroutines are still running OR just call exit before falling off the -end. The reason for this is that some coroutine of yours might have called -into a C function, and falling off the end of main:: results in returning -to that C function instead if to the main C interpreter. - -WARNING: Unless you really know what you are doing, do NOT do context -switches inside callbacks from the XS level. The reason for this is -similar to the reason above: A callback calls a perl function, this -perl function does a context switch, some other callback is called, the -original function returns from it - to what? To the wrong XS function, -with totally different return values. Unfortunately, this includes -callbacks done by perl itself (tie'd variables!). - -The only workaround for this is to do coroutines on C level. ++ @_ + $_ + $@ + $^W + C stack), that is, a coroutine has it's own +callchain, it's own set of lexicals and it's own set of perl's most +important global variables. =cut @@ -54,13 +38,14 @@ use base Exporter; -$VERSION = 0.10; +$VERSION = 0.45; @EXPORT = qw(async cede schedule terminate current); @EXPORT_OK = qw($current); { my @async; + my $init; # this way of handling attributes simply is NOT scalable ;() sub import { @@ -72,6 +57,13 @@ for (@_) { if ($_ eq "Coro") { push @async, $ref; + unless ($init++) { + eval q{ + sub INIT { + &async(pop @async) while @async; + } + }; + } } else { push @attrs, $_; } @@ -80,9 +72,6 @@ }; } - sub INIT { - &async(pop @async) while @async; - } } =item $main @@ -121,8 +110,15 @@ exit(51); }; -# we really need priorities... -my @ready; # the ready queue. hehe, rather broken ;) +# this coroutine is necessary because a coroutine +# cannot destroy itself. +my @destroy; +my $manager = new Coro sub { + while() { + delete ((pop @destroy)->{_coro_state}) while @destroy; + &schedule; + } +}; # static methods. not really. @@ -150,6 +146,7 @@ sub async(&@) { my $pid = new Coro @_; + $manager->ready; # this ensures that the stack is cloned from the manager $pid->ready; $pid; } @@ -162,14 +159,6 @@ =cut -my $prev; - -sub schedule { - # should be done using priorities :( - ($prev, $current) = ($current, shift @ready || $idle); - Coro::State::transfer($prev, $current); -} - =item cede "Cede" to other processes. This function puts the current process into the @@ -178,11 +167,6 @@ =cut -sub cede { - $current->ready; - &schedule; -} - =item terminate Terminates the current process. @@ -192,12 +176,9 @@ =cut sub terminate { - my $self = $current; - $self->{_results} = [@_]; - $current = shift @ready || $idle; - Coro::State::transfer(delete $self->{_coro_state}, $current); - # cannot return - die; + $current->cancel; + &schedule; + die; # NORETURN } =back @@ -238,8 +219,15 @@ =cut -sub ready { - push @ready, $_[0]; +=item $process->cancel + +Like C, but terminates the specified process instead. + +=cut + +sub cancel { + push @destroy, $_[0]; + $manager->ready; } =back @@ -265,7 +253,8 @@ =head1 SEE ALSO L, L, L, L, -L, L, L. +L, L, L, L, +L, L. =head1 AUTHOR