--- Coro/Coro.pm	2007/09/19 21:39:15	1.128
+++ Coro/Coro.pm	2007/10/13 23:19:10	1.155
@@ -8,15 +8,22 @@
 
  async {
     # some asynchronous thread of execution
+    print "2\n";
+    cede; # yield back to main
+    print "4\n";
  };
-
- # alternatively create an async coroutine like this:
-
- sub some_func : Coro {
-    # some more async code
- }
-
- cede;
+ print "1\n";
+ cede; # yield to coroutine
+ print "3\n";
+ cede; # and again
+
+ # use locking
+ my $lock = new Coro::Semaphore;
+ my $locked;
+
+ $lock->down;
+ $locked = 1;
+ $lock->up;
 
 =head1 DESCRIPTION
 
@@ -35,7 +42,7 @@
 In this module, coroutines are defined as "callchain + lexical variables +
 @_ + $_ + $@ + $/ + C stack), that is, a coroutine has its own callchain,
 its own set of lexicals and its own set of perls most important global
-variables.
+variables (see L<Coro::State> for more configuration).
 
 =cut
 
@@ -52,7 +59,7 @@
 our $main;    # main coroutine
 our $current; # current coroutine
 
-our $VERSION = '3.7';
+our $VERSION = '4.13';
 
 our @EXPORT = qw(async async_pool cede schedule terminate current unblock_sub);
 our %EXPORT_TAGS = (
@@ -115,8 +122,10 @@
 
 =cut
 
+$main->{desc} = "[main::]";
+
 # maybe some other module used Coro::Specific before...
-$main->{specific} = $current->{specific}
+$main->{_specific} = $current->{_specific}
    if $current;
 
 _set_current $main;
@@ -134,7 +143,7 @@
 coroutine so the scheduler can run it.
 
 Please note that if your callback recursively invokes perl (e.g. for event
-handlers), then it must be prepared to be called recursively.
+handlers), then it must be prepared to be called recursively itself.
 
 =cut
 
@@ -151,8 +160,8 @@
       or return;
 
    # call all destruction callbacks
-   $_->(@{$self->{status}})
-      for @{(delete $self->{destroy_cb}) || []};
+   $_->(@{$self->{_status}})
+      for @{(delete $self->{_on_destroy}) || []};
 }
 
 # this coroutine is necessary because a coroutine
@@ -168,7 +177,7 @@
       &schedule;
    }
 };
-
+$manager->desc ("[coro manager]");
 $manager->prio (PRIO_MAX);
 
 # static methods. not really.
@@ -187,6 +196,9 @@
 (usually unused). When the sub returns the new coroutine is automatically
 terminated.
 
+See the C<Coro::State::new> constructor for info about the coroutine
+environment in which coroutines run.
+
 Calling C<exit> in a coroutine will do the same as calling exit outside
 the coroutine. Likewise, when the coroutine dies, the program will exit,
 just as it would in the main program.
@@ -216,46 +228,50 @@
 will not work in the expected way, unless you call terminate or cancel,
 which somehow defeats the purpose of pooling.
 
-The priority will be reset to C<0> after each job, otherwise the coroutine
-will be re-used "as-is".
+The priority will be reset to C<0> after each job, tracing will be
+disabled, the description will be reset and the default output filehandle
+gets restored, so you can change alkl these. Otherwise the coroutine will
+be re-used "as-is": most notably if you change other per-coroutine global
+stuff such as C<$/> you need to revert that change, which is most simply
+done by using local as in C< local $/ >.
 
 The pool size is limited to 8 idle coroutines (this can be adjusted by
 changing $Coro::POOL_SIZE), and there can be as many non-idle coros as
 required.
 
 If you are concerned about pooled coroutines growing a lot because a
-single C<async_pool> used a lot of stackspace you can e.g. C<async_pool {
-terminate }> once per second or so to slowly replenish the pool.
+single C<async_pool> used a lot of stackspace you can e.g. C<async_pool
+{ terminate }> once per second or so to slowly replenish the pool. In
+addition to that, when the stacks used by a handler grows larger than 16kb
+(adjustable with $Coro::POOL_RSS) it will also exit.
 
 =cut
 
 our $POOL_SIZE = 8;
-our @pool;
+our $POOL_RSS  = 16 * 1024;
+our @async_pool;
 
 sub pool_handler {
+   my $cb;
+
    while () {
       eval {
-         my ($cb, @arg) = @{ delete $current->{_invoke} or return };
-         $cb->(@arg);
+         while () {
+            _pool_1 $cb;
+            &$cb;
+            _pool_2 $cb;
+            &schedule;
+         }
       };
-      warn $@ if $@;
 
-      last if @pool >= $POOL_SIZE;
-      push @pool, $current;
-
-      $current->save (Coro::State::SAVE_DEF);
-      $current->prio (0);
-      schedule;
+      last if $@ eq "\3async_pool terminate\2\n";
+      warn $@ if $@;
    }
 }
 
 sub async_pool(&@) {
    # this is also inlined into the unlock_scheduler
-   my $coro = (pop @pool) || do {
-      my $coro = new Coro \&pool_handler;
-      $coro->{desc} = "async_pool";
-      $coro
-   };
+   my $coro = (pop @async_pool) || new Coro \&pool_handler;
 
    $coro->{_invoke} = [@_];
    $coro->ready;
@@ -295,25 +311,34 @@
 ready queue and calls C<schedule>, which has the effect of giving up the
 current "timeslice" to other coroutines of the same or higher priority.
 
-Returns true if at least one coroutine switch has happened.
-
 =item Coro::cede_notself
 
 Works like cede, but is not exported by default and will cede to any
 coroutine, regardless of priority, once.
 
-Returns true if at least one coroutine switch has happened.
-
 =item terminate [arg...]
 
 Terminates the current coroutine with the given status values (see L<cancel>).
 
+=item killall
+
+Kills/terminates/cancels all coroutines except the currently running
+one. This is useful after a fork, either in the child or the parent, as
+usually only one of them should inherit the running coroutines.
+
 =cut
 
 sub terminate {
    $current->cancel (@_);
 }
 
+sub killall {
+   for (Coro::State::list) {
+      $_->cancel
+         if $_ != $current && UNIVERSAL::isa $_, "Coro";
+   }
+}
+
 =back
 
 # dynamic methods
@@ -331,7 +356,8 @@
 called. To make the coroutine run you must first put it into the ready queue
 by calling the ready method.
 
-See C<async> for additional discussion.
+See C<async> and C<Coro::State::new> for additional info about the
+coroutine environment.
 
 =cut
 
@@ -365,7 +391,7 @@
 
 sub cancel {
    my $self = shift;
-   $self->{status} = [@_];
+   $self->{_status} = [@_];
 
    if ($current == $self) {
       push @destroy, $self;
@@ -379,18 +405,18 @@
 =item $coroutine->join
 
 Wait until the coroutine terminates and return any values given to the
-C<terminate> or C<cancel> functions. C<join> can be called multiple times
-from multiple coroutine.
+C<terminate> or C<cancel> functions. C<join> can be called concurrently
+from multiple coroutines.
 
 =cut
 
 sub join {
    my $self = shift;
 
-   unless ($self->{status}) {
+   unless ($self->{_status}) {
       my $current = $current;
 
-      push @{$self->{destroy_cb}}, sub {
+      push @{$self->{_on_destroy}}, sub {
          $current->ready;
          undef $current;
       };
@@ -398,7 +424,7 @@
       &schedule while $current;
    }
 
-   wantarray ? @{$self->{status}} : $self->{status}[0];
+   wantarray ? @{$self->{_status}} : $self->{_status}[0];
 }
 
 =item $coroutine->on_destroy (\&cb)
@@ -412,7 +438,7 @@
 sub on_destroy {
    my ($self, $cb) = @_;
 
-   push @{ $self->{destroy_cb} }, $cb;
+   push @{ $self->{_on_destroy} }, $cb;
 }
 
 =item $oldprio = $coroutine->prio ($newprio)
@@ -447,6 +473,25 @@
 Sets (or gets in case the argument is missing) the description for this
 coroutine. This is just a free-form string you can associate with a coroutine.
 
+This method simply sets the C<< $coroutine->{desc} >> member to the given string. You
+can modify this member directly if you wish.
+
+=item $coroutine->throw ([$scalar])
+
+If C<$throw> is specified and defined, it will be thrown as an exception
+inside the coroutine at the next convinient point in time (usually after
+it gains control at the next schedule/transfer/cede). Otherwise clears the
+exception object.
+
+The exception object will be thrown "as is" with the specified scalar in
+C<$@>, i.e. if it is a string, no line number or newline will be appended
+(unlike with C<die>).
+
+This can be used as a softer means than C<cancel> to ask a coroutine to
+end itself, although there is no guarentee that the exception will lead to
+termination, and if the exception isn't caught it might well end the whole
+program.
+
 =cut
 
 sub desc {
@@ -531,11 +576,11 @@
 # to reduce pressure on the coro pool (because most callbacks
 # return immediately and can be reused) and because we cannot cede
 # inside an event callback.
-our $unblock_scheduler = async {
+our $unblock_scheduler = new Coro sub {
    while () {
       while (my $cb = pop @unblock_queue) {
          # this is an inlined copy of async_pool
-         my $coro = (pop @pool or new Coro \&pool_handler);
+         my $coro = (pop @async_pool) || new Coro \&pool_handler;
 
          $coro->{_invoke} = $cb;
          $coro->ready;
@@ -544,6 +589,7 @@
       schedule; # sleep well
    }
 };
+$unblock_scheduler->desc ("[unblock_sub scheduler]");
 
 sub unblock_sub(&) {
    my $cb = shift;
@@ -572,13 +618,19 @@
 
 =head1 SEE ALSO
 
-Support/Utility: L<Coro::Cont>, L<Coro::Specific>, L<Coro::State>, L<Coro::Util>.
+Lower level Configuration, Coroutine Environment: L<Coro::State>.
+
+Debugging: L<Coro::Debug>.
+
+Support/Utility: L<Coro::Specific>, L<Coro::Util>.
 
 Locking/IPC: L<Coro::Signal>, L<Coro::Channel>, L<Coro::Semaphore>, L<Coro::SemaphoreSet>, L<Coro::RWLock>.
 
-Event/IO: L<Coro::Timer>, L<Coro::Event>, L<Coro::Handle>, L<Coro::Socket>, L<Coro::Select>.
+Event/IO: L<Coro::Timer>, L<Coro::Event>, L<Coro::Handle>, L<Coro::Socket>.
+
+Compatibility: L<Coro::LWP>, L<Coro::Storable>, L<Coro::Select>.
 
-Embedding: L<Coro:MakeMaker>
+Embedding: L<Coro:MakeMaker>.
 
 =head1 AUTHOR