--- Coro/Coro.pm 2001/07/21 18:21:45 1.20 +++ Coro/Coro.pm 2001/10/03 01:09:56 1.38 @@ -16,7 +16,7 @@ # some more async code } - yield; + cede; =head1 DESCRIPTION @@ -26,25 +26,31 @@ 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. ++ @_ + $_ + $@ + $^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; +no warnings qw(uninitialized); + use Coro::State; use base Exporter; -$VERSION = 0.10; +$VERSION = 0.51; -@EXPORT = qw(async yield schedule terminate current); -@EXPORT_OK = qw($current); +@EXPORT = qw(async cede schedule terminate current); +%EXPORT_TAGS = ( + prio => [qw(PRIO_MAX PRIO_HIGH PRIO_NORMAL PRIO_LOW PRIO_IDLE PRIO_MIN)], +); +@EXPORT_OK = @{$EXPORT_TAGS{prio}}; { my @async; + my $init; # this way of handling attributes simply is NOT scalable ;() sub import { @@ -56,6 +62,13 @@ for (@_) { if ($_ eq "Coro") { push @async, $ref; + unless ($init++) { + eval q{ + sub INIT { + &async(pop @async) while @async; + } + }; + } } else { push @attrs, $_; } @@ -64,9 +77,6 @@ }; } - sub INIT { - &async(pop @async) while @async; - } } =item $main @@ -105,8 +115,21 @@ 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; +$manager = new Coro sub { + while() { + # by overwriting the state object with the manager we destroy it + # while still being able to schedule this coroutine (in case it has + # been readied multiple times. this is harmless since the manager + # can be called as many times as neccessary and will always + # remove itself from the runqueue + (pop @destroy)->{_coro_state} = $manager->{_coro_state} while @destroy; + &schedule; + } +}; # static methods. not really. @@ -134,6 +157,7 @@ sub async(&@) { my $pid = new Coro @_; + $manager->ready; # this ensures that the stack is cloned from the manager $pid->ready; $pid; } @@ -146,26 +170,14 @@ =cut -my $prev; +=item cede -sub schedule { - # should be done using priorities :( - ($prev, $current) = ($current, shift @ready || $idle); - Coro::State::transfer($prev, $current); -} - -=item yield - -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. @@ -175,8 +187,9 @@ =cut sub terminate { - $current->{_results} = [@_]; + $current->cancel; &schedule; + die; # NORETURN } =back @@ -217,8 +230,56 @@ =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; + &schedule if $current == $_[0]; +} + +=item $oldprio = $process->prio($newprio) + +Sets the priority of the process. Higher priority processes get run before +lower priority processes. Priorities are smalled signed integer (currently +-4 .. +3), that you can refer to using PRIO_xxx constants (use the import +tag :prio to get then): + + PRIO_MAX > PRIO_HIGH > PRIO_NORMAL > PRIO_LOW > PRIO_IDLE > PRIO_MIN + 3 > 1 > 0 > -1 > -3 > -4 + + # set priority to HIGH + current->prio(PRIO_HIGH); + +The idle coroutine ($Coro::idle) always has a lower priority than any +existing coroutine. + +Changing the priority of the current process will take effect immediately, +but changing the priority of processes in the ready queue (but not +running) will only take effect after the next schedule (of that +process). This is a bug that will be fixed in some future version. + +=cut + +sub prio { + my $old = $_[0]{prio}; + $_[0]{prio} = $_[1] if @_ > 1; + $old; +} + +=item $newprio = $process->nice($change) + +Similar to C, but subtract the given value from the priority (i.e. +higher values mean lower priority, just as in unix). + +=cut + +sub nice { + $_[0]{prio} -= $_[1]; } =back @@ -229,14 +290,8 @@ =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. + - you must make very sure that no coro is still active on global destruction. + very bad things might happen otherwise (usually segfaults). - 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). @@ -244,7 +299,8 @@ =head1 SEE ALSO L, L, L, L, -L, L, L. +L, L, L, L, +L, L. =head1 AUTHOR