--- cvsroot/Coro/Coro.pm 2001/07/17 00:24:14 1.13 +++ cvsroot/Coro/Coro.pm 2001/08/11 19:59:19 1.30 @@ -16,10 +16,20 @@ # some more async code } - yield; + cede; =head1 DESCRIPTION +This module collection manages coroutines. Coroutines are similar to +Threads but don't run in parallel. + +This module is still experimental, see the BUGS section below. + +In this module, coroutines are defined as "callchain + lexical variables ++ @_ + $_ + $@ + $^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 package Coro; @@ -28,15 +38,14 @@ use base Exporter; -$VERSION = 0.05; +$VERSION = 0.45; -@EXPORT = qw(async yield schedule terminate); +@EXPORT = qw(async cede schedule terminate current); @EXPORT_OK = qw($current); { - use subs 'async'; - my @async; + my $init; # this way of handling attributes simply is NOT scalable ;() sub import { @@ -48,17 +57,21 @@ for (@_) { if ($_ eq "Coro") { push @async, $ref; + unless ($init++) { + eval q{ + sub INIT { + &async(pop @async) while @async; + } + }; + } } else { - push @attrs, @_; + push @attrs, $_; } } - return $old ? $old->($package, $name, @attrs) : @attrs; + return $old ? $old->($package, $ref, @attrs) : @attrs; }; } - sub INIT { - async pop @async while @async; - } } =item $main @@ -69,7 +82,7 @@ our $main = new Coro; -=item $current +=item $current (or as function: current) The current coroutine (the last coroutine switched to). The initial value is C<$main> (of course). @@ -82,6 +95,8 @@ our $current = $main; +sub current() { $current } + =item $idle The coroutine to switch to when no other coroutine is running. The default @@ -95,9 +110,15 @@ exit(51); }; -# we really need priorities... -## my @ready; #d# -our @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. @@ -125,6 +146,7 @@ sub async(&@) { my $pid = new Coro @_; + $manager->ready; # this ensures that the stack is cloned from the manager $pid->ready; $pid; } @@ -137,26 +159,14 @@ =cut -my $prev; - -sub schedule { - # should be done using priorities :( - ($prev, $current) = ($current, shift @ready || $idle); - Coro::State::transfer($prev, $current); -} - -=item yield +=item cede -Yield to other processes. This function puts the current process into the -ready queue and calls C. +"Cede" to other processes. This function puts the current process into the +ready queue and calls C, which has the effect of giving up the +current "timeslice" to other coroutines of the same or higher priority. =cut -sub yield { - $current->ready; - &schedule; -} - =item terminate Terminates the current process. @@ -166,8 +176,9 @@ =cut sub terminate { - $current->{_results} = [@_]; + $current->cancel; &schedule; + die; # NORETURN } =back @@ -208,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 @@ -218,10 +236,25 @@ 1; +=head1 BUGS/LIMITATIONS + + - could be faster, especially when the core would introduce special + support for coroutines (like it does for threads). + - there is still a memleak on coroutine termination that I could not + identify. Could be as small as a single SV. + - this module is not well-tested. + - if variables or arguments "disappear" (become undef) or become + corrupted please contact the author so he cen iron out the + remaining bugs. + - this module is not thread-safe. You must only ever use this module from + the same thread (this requirement might be loosened in the future to + allow per-thread schedulers, but Coro::State does not yet allow this). + =head1 SEE ALSO L, L, L, L, -L, L, L. +L, L, L, L, +L, L. =head1 AUTHOR