--- Coro/Coro.pm 2001/07/15 02:35:52 1.9 +++ Coro/Coro.pm 2004/05/13 16:12:14 1.60 @@ -16,27 +16,41 @@ # some more async code } - yield; + cede; =head1 DESCRIPTION +This module collection manages coroutines. Coroutines are similar to +threads but don't run in parallel. + +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; +BEGIN { eval { require warnings } && warnings->unimport ("uninitialized") } + use Coro::State; +use vars qw($idle $main $current); + use base Exporter; -$VERSION = 0.04; +$VERSION = 0.96; -@EXPORT = qw(async yield schedule); -@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}}; { - use subs 'async'; - my @async; + my $init; # this way of handling attributes simply is NOT scalable ;() sub import { @@ -48,28 +62,34 @@ 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; - } } +=over 4 + =item $main This coroutine represents the main program. =cut -our $main = new Coro; +$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). @@ -80,7 +100,9 @@ $main->{specific} = $current->{specific}; } -our $current = $main; +$current = $main; + +sub current() { $current } =item $idle @@ -90,32 +112,65 @@ =cut # should be done using priorities :( -our $idle = new Coro sub { +$idle = new Coro sub { print STDERR "FATAL: deadlock detected\n"; 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 + while (@destroy) { + my $coro = pop @destroy; + $coro->{status} ||= []; + $_->ready for @{delete $coro->{join} || []}; + + # the next line destroys the _coro_state, but keeps the + # process itself intact (we basically make it a zombie + # process that always runs the manager thread, so it's possible + # to transfer() to this process). + $coro->{_coro_state} = $manager->{_coro_state}; + } + &schedule; + } +}; # static methods. not really. +=back + =head2 STATIC METHODS Static methods are actually functions that operate on the current process only. =over 4 -=item async { ... }; +=item async { ... } [@args...] Create a new asynchronous process and return it's process object (usually unused). When the sub returns the new process is automatically terminated. + # create a new coroutine that just prints its arguments + async { + print "@_\n"; + } 1,2,3,4; + =cut -sub async(&) { - (new Coro $_[0])->ready; +sub async(&@) { + my $pid = new Coro @_; + $manager->ready; # this ensures that the stack is cloned from the manager + $pid->ready; + $pid; } =item schedule @@ -126,34 +181,22 @@ =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 +=item terminate [arg...] -Terminates the current process. +Terminates the current process with the given status values (see L). =cut sub terminate { - &schedule; + $current->cancel (@_); } =back @@ -166,30 +209,116 @@ =over 4 -=item new Coro \⊂ +=item new Coro \&sub [, @args...] Create a new process and return it. When the sub returns the process -automatically terminates. To start the process you must first put it into -the ready queue by calling the ready method. +automatically terminates as if C with the returned values were +called. To make the process run you must first put it into the ready queue +by calling the ready method. =cut +sub _newcoro { + terminate &{+shift}; +} + sub new { my $class = shift; - my $proc = $_[0]; bless { - _coro_state => new Coro::State ($proc ? sub { &$proc; &terminate } : $proc), + _coro_state => (new Coro::State $_[0] && \&_newcoro, @_), }, $class; } =item $process->ready -Put the current process into the ready queue. +Put the given process into the ready queue. + +=cut + +=item $process->cancel (arg...) + +Temrinates the given process and makes it return the given arguments as +status (default: the empty list). =cut -sub ready { - push @ready, $_[0]; +sub cancel { + my $self = shift; + $self->{status} = [@_]; + push @destroy, $self; + $manager->ready; + &schedule if $current == $self; +} + +=item $process->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 processes. + +=cut + +sub join { + my $self = shift; + unless ($self->{status}) { + push @{$self->{join}}, $current; + &schedule; + } + wantarray ? @{$self->{status}} : $self->{status}[0]; +} + +=item $oldprio = $process->prio($newprio) + +Sets (or gets, if the argument is missing) the priority of the +process. Higher priority processes get run before lower priority +processes. Priorities are small signed integers (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]; +} + +=item $olddesc = $process->desc($newdesc) + +Sets (or gets in case the argument is missing) the description for this +process. This is just a free-form string you can associate with a process. + +=cut + +sub desc { + my $old = $_[0]{desc}; + $_[0]{desc} = $_[1] if @_ > 1; + $old; } =back @@ -198,10 +327,21 @@ 1; +=head1 BUGS/LIMITATIONS + + - 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 should only ever use this module + from the same thread (this requirement might be losened 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, Handle>, L. =head1 AUTHOR