--- Coro/Coro.pm 2001/07/17 02:21:56 1.14 +++ Coro/Coro.pm 2001/07/23 02:14:19 1.22 @@ -16,7 +16,7 @@ # some more async code } - yield; + cede; =head1 DESCRIPTION @@ -25,6 +25,27 @@ 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. + =cut package Coro; @@ -33,14 +54,12 @@ use base Exporter; -$VERSION = 0.05; +$VERSION = 0.10; -@EXPORT = qw(async yield schedule terminate); +@EXPORT = qw(async cede schedule terminate current); @EXPORT_OK = qw($current); { - use subs 'async'; - my @async; # this way of handling attributes simply is NOT scalable ;() @@ -54,15 +73,15 @@ if ($_ eq "Coro") { push @async, $ref; } 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; + &async(pop @async) while @async; } } @@ -74,7 +93,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). @@ -87,6 +106,8 @@ our $current = $main; +sub current() { $current } + =item $idle The coroutine to switch to when no other coroutine is running. The default @@ -101,8 +122,7 @@ }; # we really need priorities... -## my @ready; #d# -our @ready = (); # the ready queue. hehe, rather broken ;) +my @ready; # the ready queue. hehe, rather broken ;) # static methods. not really. @@ -150,14 +170,15 @@ 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 { +sub cede { $current->ready; &schedule; } @@ -171,8 +192,12 @@ =cut sub terminate { - $current->{_results} = [@_]; - &schedule; + my $self = $current; + $self->{_results} = [@_]; + $current = shift @ready || $idle; + Coro::State::transfer(delete $self->{_coro_state}, $current); + # cannot return + die; } =back @@ -223,13 +248,19 @@ 1; -=head1 BUGS +=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