ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro/Coro.pm
(Generate patch)

Comparing Coro/Coro.pm (file contents):
Revision 1.196 by root, Sat Aug 30 03:07:46 2008 UTC vs.
Revision 1.233 by root, Fri Nov 21 06:02:07 2008 UTC

16 cede; # yield to coroutine 16 cede; # yield to coroutine
17 print "3\n"; 17 print "3\n";
18 cede; # and again 18 cede; # and again
19 19
20 # use locking 20 # use locking
21 use Coro::Semaphore;
21 my $lock = new Coro::Semaphore; 22 my $lock = new Coro::Semaphore;
22 my $locked; 23 my $locked;
23 24
24 $lock->down; 25 $lock->down;
25 $locked = 1; 26 $locked = 1;
55 56
56=cut 57=cut
57 58
58package Coro; 59package Coro;
59 60
60use strict; 61use strict qw(vars subs);
61no warnings "uninitialized"; 62no warnings "uninitialized";
62 63
63use Coro::State; 64use Coro::State;
64 65
65use base qw(Coro::State Exporter); 66use base qw(Coro::State Exporter);
66 67
67our $idle; # idle handler 68our $idle; # idle handler
68our $main; # main coroutine 69our $main; # main coroutine
69our $current; # current coroutine 70our $current; # current coroutine
70 71
71our $VERSION = 4.745; 72our $VERSION = "5.0";
72 73
73our @EXPORT = qw(async async_pool cede schedule terminate current unblock_sub); 74our @EXPORT = qw(async async_pool cede schedule terminate current unblock_sub);
74our %EXPORT_TAGS = ( 75our %EXPORT_TAGS = (
75 prio => [qw(PRIO_MAX PRIO_HIGH PRIO_NORMAL PRIO_LOW PRIO_IDLE PRIO_MIN)], 76 prio => [qw(PRIO_MAX PRIO_HIGH PRIO_NORMAL PRIO_LOW PRIO_IDLE PRIO_MIN)],
76); 77);
85coroutines, it is mainly useful to compare again C<$Coro::current>, to see 86coroutines, it is mainly useful to compare again C<$Coro::current>, to see
86whether you are running in the main program or not. 87whether you are running in the main program or not.
87 88
88=cut 89=cut
89 90
90$main = new Coro; 91# $main is now being initialised by Coro::State
91 92
92=item $Coro::current 93=item $Coro::current
93 94
94The coroutine object representing the current coroutine (the last 95The coroutine object representing the current coroutine (the last
95coroutine that the Coro scheduler switched to). The initial value is 96coroutine that the Coro scheduler switched to). The initial value is
96C<$main> (of course). 97C<$Coro::main> (of course).
97 98
98This variable is B<strictly> I<read-only>. You can take copies of the 99This variable is B<strictly> I<read-only>. You can take copies of the
99value stored in it and use it as any other coroutine object, but you must 100value stored in it and use it as any other coroutine object, but you must
100not otherwise modify the variable itself. 101not otherwise modify the variable itself.
101 102
102=cut 103=cut
103
104$main->{desc} = "[main::]";
105
106# maybe some other module used Coro::Specific before...
107$main->{_specific} = $current->{_specific}
108 if $current;
109
110_set_current $main;
111 104
112sub current() { $current } # [DEPRECATED] 105sub current() { $current } # [DEPRECATED]
113 106
114=item $Coro::idle 107=item $Coro::idle
115 108
142$idle = sub { 135$idle = sub {
143 require Carp; 136 require Carp;
144 Carp::croak ("FATAL: deadlock detected"); 137 Carp::croak ("FATAL: deadlock detected");
145}; 138};
146 139
147sub _cancel {
148 my ($self) = @_;
149
150 # free coroutine data and mark as destructed
151 $self->_destroy
152 or return;
153
154 # call all destruction callbacks
155 $_->(@{$self->{_status}})
156 for @{(delete $self->{_on_destroy}) || []};
157}
158
159# this coroutine is necessary because a coroutine 140# this coroutine is necessary because a coroutine
160# cannot destroy itself. 141# cannot destroy itself.
161my @destroy; 142our @destroy;
162my $manager; 143our $manager;
163 144
164$manager = new Coro sub { 145$manager = new Coro sub {
165 while () { 146 while () {
166 (shift @destroy)->_cancel 147 Coro::_cancel shift @destroy
167 while @destroy; 148 while @destroy;
168 149
169 &schedule; 150 &schedule;
170 } 151 }
171}; 152};
172$manager->desc ("[coro manager]"); 153$manager->{desc} = "[coro manager]";
173$manager->prio (PRIO_MAX); 154$manager->prio (PRIO_MAX);
174 155
175=back 156=back
176 157
177=head2 SIMPLE COROUTINE CREATION 158=head2 SIMPLE COROUTINE CREATION
219Similar to C<async>, but uses a coroutine pool, so you should not call 200Similar to C<async>, but uses a coroutine pool, so you should not call
220terminate or join on it (although you are allowed to), and you get a 201terminate or join on it (although you are allowed to), and you get a
221coroutine that might have executed other code already (which can be good 202coroutine that might have executed other code already (which can be good
222or bad :). 203or bad :).
223 204
224On the plus side, this function is faster than creating (and destroying) 205On the plus side, this function is about twice as fast as creating (and
225a completely new coroutine, so if you need a lot of generic coroutines in 206destroying) a completely new coroutine, so if you need a lot of generic
226quick successsion, use C<async_pool>, not C<async>. 207coroutines in quick successsion, use C<async_pool>, not C<async>.
227 208
228The code block is executed in an C<eval> context and a warning will be 209The code block is executed in an C<eval> context and a warning will be
229issued in case of an exception instead of terminating the program, as 210issued in case of an exception instead of terminating the program, as
230C<async> does. As the coroutine is being reused, stuff like C<on_destroy> 211C<async> does. As the coroutine is being reused, stuff like C<on_destroy>
231will not work in the expected way, unless you call terminate or cancel, 212will not work in the expected way, unless you call terminate or cancel,
234 215
235The priority will be reset to C<0> after each run, tracing will be 216The priority will be reset to C<0> after each run, tracing will be
236disabled, the description will be reset and the default output filehandle 217disabled, the description will be reset and the default output filehandle
237gets restored, so you can change all these. Otherwise the coroutine will 218gets restored, so you can change all these. Otherwise the coroutine will
238be re-used "as-is": most notably if you change other per-coroutine global 219be re-used "as-is": most notably if you change other per-coroutine global
239stuff such as C<$/> you I<must needs> to revert that change, which is most 220stuff such as C<$/> you I<must needs> revert that change, which is most
240simply done by using local as in: C< local $/ >. 221simply done by using local as in: C<< local $/ >>.
241 222
242The pool size is limited to C<8> idle coroutines (this can be adjusted by 223The idle pool size is limited to C<8> idle coroutines (this can be
243changing $Coro::POOL_SIZE), and there can be as many non-idle coros as 224adjusted by changing $Coro::POOL_SIZE), but there can be as many non-idle
244required. 225coros as required.
245 226
246If you are concerned about pooled coroutines growing a lot because a 227If you are concerned about pooled coroutines growing a lot because a
247single C<async_pool> used a lot of stackspace you can e.g. C<async_pool 228single C<async_pool> used a lot of stackspace you can e.g. C<async_pool
248{ terminate }> once per second or so to slowly replenish the pool. In 229{ terminate }> once per second or so to slowly replenish the pool. In
249addition to that, when the stacks used by a handler grows larger than 16kb 230addition to that, when the stacks used by a handler grows larger than 32kb
250(adjustable via $Coro::POOL_RSS) it will also be destroyed. 231(adjustable via $Coro::POOL_RSS) it will also be destroyed.
251 232
252=cut 233=cut
253 234
254our $POOL_SIZE = 8; 235our $POOL_SIZE = 8;
255our $POOL_RSS = 16 * 1024; 236our $POOL_RSS = 32 * 1024;
256our @async_pool; 237our @async_pool;
257 238
258sub pool_handler { 239sub pool_handler {
259 my $cb;
260
261 while () { 240 while () {
262 eval { 241 eval {
263 while () { 242 &{&_pool_handler} while 1;
264 _pool_1 $cb;
265 &$cb;
266 _pool_2 $cb;
267 &schedule;
268 }
269 }; 243 };
270 244
271 if ($@) {
272 last if $@ eq "\3async_pool terminate\2\n";
273 warn $@; 245 warn $@ if $@;
274 }
275 } 246 }
276}
277
278sub async_pool(&@) {
279 # this is also inlined into the unlock_scheduler
280 my $coro = (pop @async_pool) || new Coro \&pool_handler;
281
282 $coro->{_invoke} = [@_];
283 $coro->ready;
284
285 $coro
286} 247}
287 248
288=back 249=back
289 250
290=head2 STATIC METHODS 251=head2 STATIC METHODS
312>> on that once some event happens, and last you call C<schedule> to put 273>> on that once some event happens, and last you call C<schedule> to put
313yourself to sleep. Note that a lot of things can wake your coroutine up, 274yourself to sleep. Note that a lot of things can wake your coroutine up,
314so you need to check whether the event indeed happened, e.g. by storing the 275so you need to check whether the event indeed happened, e.g. by storing the
315status in a variable. 276status in a variable.
316 277
317The canonical way to wait on external events is this: 278See B<HOW TO WAIT FOR A CALLBACK>, below, for some ways to wait for callbacks.
318
319 {
320 # remember current coroutine
321 my $current = $Coro::current;
322
323 # register a hypothetical event handler
324 on_event_invoke sub {
325 # wake up sleeping coroutine
326 $current->ready;
327 undef $current;
328 };
329
330 # call schedule until event occurred.
331 # in case we are woken up for other reasons
332 # (current still defined), loop.
333 Coro::schedule while $current;
334 }
335 279
336=item cede 280=item cede
337 281
338"Cede" to other coroutines. This function puts the current coroutine into 282"Cede" to other coroutines. This function puts the current coroutine into
339the ready queue and calls C<schedule>, which has the effect of giving 283the ready queue and calls C<schedule>, which has the effect of giving
363you cannot free all of them, so if a coroutine that is not the main 307you cannot free all of them, so if a coroutine that is not the main
364program calls this function, there will be some one-time resource leak. 308program calls this function, there will be some one-time resource leak.
365 309
366=cut 310=cut
367 311
368sub terminate {
369 $current->cancel (@_);
370}
371
372sub killall { 312sub killall {
373 for (Coro::State::list) { 313 for (Coro::State::list) {
374 $_->cancel 314 $_->cancel
375 if $_ != $current && UNIVERSAL::isa $_, "Coro"; 315 if $_ != $current && UNIVERSAL::isa $_, "Coro";
376 } 316 }
395See C<async> and C<Coro::State::new> for additional info about the 335See C<async> and C<Coro::State::new> for additional info about the
396coroutine environment. 336coroutine environment.
397 337
398=cut 338=cut
399 339
400sub _run_coro { 340sub _terminate {
401 terminate &{+shift}; 341 terminate &{+shift};
402}
403
404sub new {
405 my $class = shift;
406
407 $class->SUPER::new (\&_run_coro, @_)
408} 342}
409 343
410=item $success = $coroutine->ready 344=item $success = $coroutine->ready
411 345
412Put the given coroutine into the end of its ready queue (there is one 346Put the given coroutine into the end of its ready queue (there is one
429 363
430=cut 364=cut
431 365
432sub cancel { 366sub cancel {
433 my $self = shift; 367 my $self = shift;
434 $self->{_status} = [@_];
435 368
436 if ($current == $self) { 369 if ($current == $self) {
437 push @destroy, $self; 370 terminate @_;
438 $manager->ready;
439 &schedule while 1;
440 } else { 371 } else {
372 $self->{_status} = [@_];
441 $self->_cancel; 373 $self->_cancel;
442 } 374 }
443} 375}
376
377=item $coroutine->schedule_to
378
379Puts the current coroutine to sleep (like C<Coro::schedule>), but instead
380of continuing with the next coro from the ready queue, always switch to
381the given coroutine object (regardless of priority etc.). The readyness
382state of that coroutine isn't changed.
383
384This is an advanced method for special cases - I'd love to hear about any
385uses for this one.
386
387=item $coroutine->cede_to
388
389Like C<schedule_to>, but puts the current coroutine into the ready
390queue. This has the effect of temporarily switching to the given
391coroutine, and continuing some time later.
392
393This is an advanced method for special cases - I'd love to hear about any
394uses for this one.
395
396=item $coroutine->throw ([$scalar])
397
398If C<$throw> is specified and defined, it will be thrown as an exception
399inside the coroutine at the next convenient point in time. Otherwise
400clears the exception object.
401
402Coro will check for the exception each time a schedule-like-function
403returns, i.e. after each C<schedule>, C<cede>, C<< Coro::Semaphore->down
404>>, C<< Coro::Handle->readable >> and so on. Most of these functions
405detect this case and return early in case an exception is pending.
406
407The exception object will be thrown "as is" with the specified scalar in
408C<$@>, i.e. if it is a string, no line number or newline will be appended
409(unlike with C<die>).
410
411This can be used as a softer means than C<cancel> to ask a coroutine to
412end itself, although there is no guarantee that the exception will lead to
413termination, and if the exception isn't caught it might well end the whole
414program.
415
416You might also think of C<throw> as being the moral equivalent of
417C<kill>ing a coroutine with a signal (in this case, a scalar).
444 418
445=item $coroutine->join 419=item $coroutine->join
446 420
447Wait until the coroutine terminates and return any values given to the 421Wait until the coroutine terminates and return any values given to the
448C<terminate> or C<cancel> functions. C<join> can be called concurrently 422C<terminate> or C<cancel> functions. C<join> can be called concurrently
510higher values mean lower priority, just as in unix). 484higher values mean lower priority, just as in unix).
511 485
512=item $olddesc = $coroutine->desc ($newdesc) 486=item $olddesc = $coroutine->desc ($newdesc)
513 487
514Sets (or gets in case the argument is missing) the description for this 488Sets (or gets in case the argument is missing) the description for this
515coroutine. This is just a free-form string you can associate with a coroutine. 489coroutine. This is just a free-form string you can associate with a
490coroutine.
516 491
517This method simply sets the C<< $coroutine->{desc} >> member to the given string. You 492This method simply sets the C<< $coroutine->{desc} >> member to the given
518can modify this member directly if you wish. 493string. You can modify this member directly if you wish.
519
520=item $coroutine->throw ([$scalar])
521
522If C<$throw> is specified and defined, it will be thrown as an exception
523inside the coroutine at the next convinient point in time (usually after
524it gains control at the next schedule/transfer/cede). Otherwise clears the
525exception object.
526
527The exception object will be thrown "as is" with the specified scalar in
528C<$@>, i.e. if it is a string, no line number or newline will be appended
529(unlike with C<die>).
530
531This can be used as a softer means than C<cancel> to ask a coroutine to
532end itself, although there is no guarentee that the exception will lead to
533termination, and if the exception isn't caught it might well end the whole
534program.
535 494
536=cut 495=cut
537 496
538sub desc { 497sub desc {
539 my $old = $_[0]{desc}; 498 my $old = $_[0]{desc};
540 $_[0]{desc} = $_[1] if @_ > 1; 499 $_[0]{desc} = $_[1] if @_ > 1;
541 $old; 500 $old;
501}
502
503sub transfer {
504 require Carp;
505 Carp::croak ("You must not call ->transfer on Coro objects. Use Coro::State objects or the ->schedule_to method. Caught");
542} 506}
543 507
544=back 508=back
545 509
546=head2 GLOBAL FUNCTIONS 510=head2 GLOBAL FUNCTIONS
631# return immediately and can be reused) and because we cannot cede 595# return immediately and can be reused) and because we cannot cede
632# inside an event callback. 596# inside an event callback.
633our $unblock_scheduler = new Coro sub { 597our $unblock_scheduler = new Coro sub {
634 while () { 598 while () {
635 while (my $cb = pop @unblock_queue) { 599 while (my $cb = pop @unblock_queue) {
636 # this is an inlined copy of async_pool 600 &async_pool (@$cb);
637 my $coro = (pop @async_pool) || new Coro \&pool_handler;
638 601
639 $coro->{_invoke} = $cb;
640 $coro->ready;
641 cede; # for short-lived callbacks, this reduces pressure on the coro pool 602 # for short-lived callbacks, this reduces pressure on the coro pool
603 # as the chance is very high that the async_poll coro will be back
604 # in the idle state when cede returns
605 cede;
642 } 606 }
643 schedule; # sleep well 607 schedule; # sleep well
644 } 608 }
645}; 609};
646$unblock_scheduler->desc ("[unblock_sub scheduler]"); 610$unblock_scheduler->{desc} = "[unblock_sub scheduler]";
647 611
648sub unblock_sub(&) { 612sub unblock_sub(&) {
649 my $cb = shift; 613 my $cb = shift;
650 614
651 sub { 615 sub {
652 unshift @unblock_queue, [$cb, @_]; 616 unshift @unblock_queue, [$cb, @_];
653 $unblock_scheduler->ready; 617 $unblock_scheduler->ready;
654 } 618 }
655} 619}
656 620
621=item $cb = Coro::rouse_cb
622
623Create and return a "rouse callback". That's a code reference that, when
624called, will save its arguments and notify the owner coroutine of the
625callback.
626
627See the next function.
628
629=item @args = Coro::rouse_wait [$cb]
630
631Wait for the specified rouse callback (or the last one tht was created in
632this coroutine).
633
634As soon as the callback is invoked (or when the calback was invoked before
635C<rouse_wait>), it will return a copy of the arguments originally passed
636to the rouse callback.
637
638See the section B<HOW TO WAIT FOR A CALLBACK> for an actual usage example.
639
657=back 640=back
658 641
659=cut 642=cut
660 643
6611; 6441;
662 645
646=head1 HOW TO WAIT FOR A CALLBACK
647
648It is very common for a coroutine to wait for some callback to be
649called. This occurs naturally when you use coroutines in an otherwise
650event-based program, or when you use event-based libraries.
651
652These typically register a callback for some event, and call that callback
653when the event occured. In a coroutine, however, you typically want to
654just wait for the event, simplyifying things.
655
656For example C<< AnyEvent->child >> registers a callback to be called when
657a specific child has exited:
658
659 my $child_watcher = AnyEvent->child (pid => $pid, cb => sub { ... });
660
661But from withina coroutine, you often just want to write this:
662
663 my $status = wait_for_child $pid;
664
665Coro offers two functions specifically designed to make this easy,
666C<Coro::rouse_cb> and C<Coro::rouse_wait>.
667
668The first function, C<rouse_cb>, generates and returns a callback that,
669when invoked, will save it's arguments and notify the coroutine that
670created the callback.
671
672The second function, C<rouse_wait>, waits for the callback to be called
673(by calling C<schedule> to go to sleep) and returns the arguments
674originally passed to the callback.
675
676Using these functions, it becomes easy to write the C<wait_for_child>
677function mentioned above:
678
679 sub wait_for_child($) {
680 my ($pid) = @_;
681
682 my $watcher = AnyEvent->child (pid => $pid, cb => Coro::rouse_cb);
683
684 my ($rpid, $rstatus) = Coro::rouse_wait;
685 $rstatus
686 }
687
688In the case where C<rouse_cb> and C<rouse_wait> are not flexible enough,
689you can roll your own, using C<schedule>:
690
691 sub wait_for_child($) {
692 my ($pid) = @_;
693
694 # store the current coroutine in $current,
695 # and provide result variables for the closure passed to ->child
696 my $current = $Coro::current;
697 my ($done, $rstatus);
698
699 # pass a closure to ->child
700 my $watcher = AnyEvent->child (pid => $pid, cb => sub {
701 $rstatus = $_[1]; # remember rstatus
702 $done = 1; # mark $rstatus as valud
703 });
704
705 # wait until the closure has been called
706 schedule while !$done;
707
708 $rstatus
709 }
710
711
663=head1 BUGS/LIMITATIONS 712=head1 BUGS/LIMITATIONS
713
714=over 4
715
716=item fork with pthread backend
717
718When Coro is compiled using the pthread backend (which isn't recommended
719but required on many BSDs as their libcs are completely broken), then
720coroutines will not survive a fork. There is no known workaround except to
721fix your libc and use a saner backend.
722
723=item perl process emulation ("threads")
664 724
665This module is not perl-pseudo-thread-safe. You should only ever use this 725This module is not perl-pseudo-thread-safe. You should only ever use this
666module from the same thread (this requirement might be removed in the 726module from the same thread (this requirement might be removed in the
667future to allow per-thread schedulers, but Coro::State does not yet allow 727future to allow per-thread schedulers, but Coro::State does not yet allow
668this). I recommend disabling thread support and using processes, as this 728this). I recommend disabling thread support and using processes, as having
669is much faster and uses less memory. 729the windows process emulation enabled under unix roughly halves perl
730performance, even when not used.
731
732=item coroutine switching not signal safe
733
734You must not switch to another coroutine from within a signal handler
735(only relevant with %SIG - most event libraries provide safe signals).
736
737That means you I<MUST NOT> call any function that might "block" the
738current coroutine - C<cede>, C<schedule> C<< Coro::Semaphore->down >> or
739anything that calls those. Everything else, including calling C<ready>,
740works.
741
742=back
743
670 744
671=head1 SEE ALSO 745=head1 SEE ALSO
672 746
673Event-Loop integration: L<Coro::AnyEvent>, L<Coro::EV>, L<Coro::Event>. 747Event-Loop integration: L<Coro::AnyEvent>, L<Coro::EV>, L<Coro::Event>.
674 748

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines