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

Comparing Coro/Coro.pm (file contents):
Revision 1.186 by root, Sun May 25 01:32:36 2008 UTC vs.
Revision 1.226 by root, Wed Nov 19 16:01:32 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.72'; 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);
81=item $Coro::main 82=item $Coro::main
82 83
83This variable stores the coroutine object that represents the main 84This variable stores the coroutine object that represents the main
84program. While you cna C<ready> it and do most other things you can do to 85program. While you cna C<ready> it and do most other things you can do to
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
86wether 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
151 $self->_destroy 144 $self->_destroy
152 or return; 145 or return;
153 146
154 # call all destruction callbacks 147 # call all destruction callbacks
155 $_->(@{$self->{_status}}) 148 $_->(@{$self->{_status}})
156 for @{(delete $self->{_on_destroy}) || []}; 149 for @{ delete $self->{_on_destroy} || [] };
157} 150}
158 151
159# this coroutine is necessary because a coroutine 152# this coroutine is necessary because a coroutine
160# cannot destroy itself. 153# cannot destroy itself.
161my @destroy; 154our @destroy;
162my $manager; 155our $manager;
163 156
164$manager = new Coro sub { 157$manager = new Coro sub {
165 while () { 158 while () {
166 (shift @destroy)->_cancel 159 (shift @destroy)->_cancel
167 while @destroy; 160 while @destroy;
168 161
169 &schedule; 162 &schedule;
170 } 163 }
171}; 164};
172$manager->desc ("[coro manager]"); 165$manager->{desc} = "[coro manager]";
173$manager->prio (PRIO_MAX); 166$manager->prio (PRIO_MAX);
174 167
175=back 168=back
176 169
177=head2 SIMPLE COROUTINE CREATION 170=head2 SIMPLE COROUTINE CREATION
220terminate or join on it (although you are allowed to), and you get a 213terminate 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 214coroutine that might have executed other code already (which can be good
222or bad :). 215or bad :).
223 216
224On the plus side, this function is faster than creating (and destroying) 217On the plus side, this function is faster than creating (and destroying)
225a completely new coroutine, so if you need a lot of generic coroutines in 218a completly new coroutine, so if you need a lot of generic coroutines in
226quick successsion, use C<async_pool>, not C<async>. 219quick successsion, use C<async_pool>, not C<async>.
227 220
228The code block is executed in an C<eval> context and a warning will be 221The 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 222issued 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> 223C<async> does. As the coroutine is being reused, stuff like C<on_destroy>
234 227
235The priority will be reset to C<0> after each run, tracing will be 228The priority will be reset to C<0> after each run, tracing will be
236disabled, the description will be reset and the default output filehandle 229disabled, the description will be reset and the default output filehandle
237gets restored, so you can change all these. Otherwise the coroutine will 230gets 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 231be 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 232stuff such as C<$/> you I<must needs> revert that change, which is most
240simply done by using local as in: C< local $/ >. 233simply done by using local as in: C<< local $/ >>.
241 234
242The pool size is limited to C<8> idle coroutines (this can be adjusted by 235The 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 236adjusted by changing $Coro::POOL_SIZE), but there can be as many non-idle
244required. 237coros as required.
245 238
246If you are concerned about pooled coroutines growing a lot because a 239If 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 240single 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 241{ 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 242addition to that, when the stacks used by a handler grows larger than 16kb
266 _pool_2 $cb; 259 _pool_2 $cb;
267 &schedule; 260 &schedule;
268 } 261 }
269 }; 262 };
270 263
264 if ($@) {
271 last if $@ eq "\3async_pool terminate\2\n"; 265 last if $@ eq "\3async_pool terminate\2\n";
272 warn $@ if $@; 266 warn $@;
267 }
273 } 268 }
274} 269}
275 270
276sub async_pool(&@) { 271sub async_pool(&@) {
277 # this is also inlined into the unlock_scheduler 272 # this is also inlined into the unblock_scheduler
278 my $coro = (pop @async_pool) || new Coro \&pool_handler; 273 my $coro = (pop @async_pool) || new Coro \&pool_handler;
279 274
280 $coro->{_invoke} = [@_]; 275 $coro->{_invoke} = [@_];
281 $coro->ready; 276 $coro->ready;
282 277
307This makes C<schedule> I<the> generic method to use to block the current 302This makes C<schedule> I<the> generic method to use to block the current
308coroutine and wait for events: first you remember the current coroutine in 303coroutine and wait for events: first you remember the current coroutine in
309a variable, then arrange for some callback of yours to call C<< ->ready 304a variable, then arrange for some callback of yours to call C<< ->ready
310>> on that once some event happens, and last you call C<schedule> to put 305>> on that once some event happens, and last you call C<schedule> to put
311yourself to sleep. Note that a lot of things can wake your coroutine up, 306yourself to sleep. Note that a lot of things can wake your coroutine up,
312so you need to check wether the event indeed happened, e.g. by storing the 307so you need to check whether the event indeed happened, e.g. by storing the
313status in a variable. 308status in a variable.
314 309
315The canonical way to wait on external events is this: 310See B<HOW TO WAIT FOR A CALLBACK>, below, for some ways to wait for callbacks.
316
317 {
318 # remember current coroutine
319 my $current = $Coro::current;
320
321 # register a hypothetical event handler
322 on_event_invoke sub {
323 # wake up sleeping coroutine
324 $current->ready;
325 undef $current;
326 };
327
328 # call schedule until event occurred.
329 # in case we are woken up for other reasons
330 # (current still defined), loop.
331 Coro::schedule while $current;
332 }
333 311
334=item cede 312=item cede
335 313
336"Cede" to other coroutines. This function puts the current coroutine into 314"Cede" to other coroutines. This function puts the current coroutine into
337the ready queue and calls C<schedule>, which has the effect of giving 315the ready queue and calls C<schedule>, which has the effect of giving
356Kills/terminates/cancels all coroutines except the currently running 334Kills/terminates/cancels all coroutines except the currently running
357one. This is useful after a fork, either in the child or the parent, as 335one. This is useful after a fork, either in the child or the parent, as
358usually only one of them should inherit the running coroutines. 336usually only one of them should inherit the running coroutines.
359 337
360Note that while this will try to free some of the main programs resources, 338Note that while this will try to free some of the main programs resources,
361you cnanot free all of them, so if a coroutine that is not the main 339you cannot free all of them, so if a coroutine that is not the main
362program calls this function, there will be some one-time resource leak. 340program calls this function, there will be some one-time resource leak.
363 341
364=cut 342=cut
365 343
366sub terminate { 344sub terminate {
367 $current->cancel (@_); 345 $current->{_status} = [@_];
346 push @destroy, $current;
347 $manager->ready;
348 do { &schedule } while 1;
368} 349}
369 350
370sub killall { 351sub killall {
371 for (Coro::State::list) { 352 for (Coro::State::list) {
372 $_->cancel 353 $_->cancel
393See C<async> and C<Coro::State::new> for additional info about the 374See C<async> and C<Coro::State::new> for additional info about the
394coroutine environment. 375coroutine environment.
395 376
396=cut 377=cut
397 378
398sub _run_coro { 379sub _terminate {
399 terminate &{+shift}; 380 terminate &{+shift};
400}
401
402sub new {
403 my $class = shift;
404
405 $class->SUPER::new (\&_run_coro, @_)
406} 381}
407 382
408=item $success = $coroutine->ready 383=item $success = $coroutine->ready
409 384
410Put the given coroutine into the end of its ready queue (there is one 385Put the given coroutine into the end of its ready queue (there is one
415once all the coroutines of higher priority and all coroutines of the same 390once all the coroutines of higher priority and all coroutines of the same
416priority that were put into the ready queue earlier have been resumed. 391priority that were put into the ready queue earlier have been resumed.
417 392
418=item $is_ready = $coroutine->is_ready 393=item $is_ready = $coroutine->is_ready
419 394
420Return wether the coroutine is currently the ready queue or not, 395Return whether the coroutine is currently the ready queue or not,
421 396
422=item $coroutine->cancel (arg...) 397=item $coroutine->cancel (arg...)
423 398
424Terminates the given coroutine and makes it return the given arguments as 399Terminates the given coroutine and makes it return the given arguments as
425status (default: the empty list). Never returns if the coroutine is the 400status (default: the empty list). Never returns if the coroutine is the
427 402
428=cut 403=cut
429 404
430sub cancel { 405sub cancel {
431 my $self = shift; 406 my $self = shift;
432 $self->{_status} = [@_];
433 407
434 if ($current == $self) { 408 if ($current == $self) {
435 push @destroy, $self; 409 terminate @_;
436 $manager->ready;
437 &schedule while 1;
438 } else { 410 } else {
411 $self->{_status} = [@_];
439 $self->_cancel; 412 $self->_cancel;
440 } 413 }
441} 414}
415
416=item $coroutine->throw ([$scalar])
417
418If C<$throw> is specified and defined, it will be thrown as an exception
419inside the coroutine at the next convenient point in time. Otherwise
420clears the exception object.
421
422Coro will check for the exception each time a schedule-like-function
423returns, i.e. after each C<schedule>, C<cede>, C<< Coro::Semaphore->down
424>>, C<< Coro::Handle->readable >> and so on. Most of these functions
425detect this case and return early in case an exception is pending.
426
427The exception object will be thrown "as is" with the specified scalar in
428C<$@>, i.e. if it is a string, no line number or newline will be appended
429(unlike with C<die>).
430
431This can be used as a softer means than C<cancel> to ask a coroutine to
432end itself, although there is no guarantee that the exception will lead to
433termination, and if the exception isn't caught it might well end the whole
434program.
435
436You might also think of C<throw> as being the moral equivalent of
437C<kill>ing a coroutine with a signal (in this case, a scalar).
442 438
443=item $coroutine->join 439=item $coroutine->join
444 440
445Wait until the coroutine terminates and return any values given to the 441Wait until the coroutine terminates and return any values given to the
446C<terminate> or C<cancel> functions. C<join> can be called concurrently 442C<terminate> or C<cancel> functions. C<join> can be called concurrently
508higher values mean lower priority, just as in unix). 504higher values mean lower priority, just as in unix).
509 505
510=item $olddesc = $coroutine->desc ($newdesc) 506=item $olddesc = $coroutine->desc ($newdesc)
511 507
512Sets (or gets in case the argument is missing) the description for this 508Sets (or gets in case the argument is missing) the description for this
513coroutine. This is just a free-form string you can associate with a coroutine. 509coroutine. This is just a free-form string you can associate with a
510coroutine.
514 511
515This method simply sets the C<< $coroutine->{desc} >> member to the given string. You 512This method simply sets the C<< $coroutine->{desc} >> member to the given
516can modify this member directly if you wish. 513string. You can modify this member directly if you wish.
517
518=item $coroutine->throw ([$scalar])
519
520If C<$throw> is specified and defined, it will be thrown as an exception
521inside the coroutine at the next convinient point in time (usually after
522it gains control at the next schedule/transfer/cede). Otherwise clears the
523exception object.
524
525The exception object will be thrown "as is" with the specified scalar in
526C<$@>, i.e. if it is a string, no line number or newline will be appended
527(unlike with C<die>).
528
529This can be used as a softer means than C<cancel> to ask a coroutine to
530end itself, although there is no guarentee that the exception will lead to
531termination, and if the exception isn't caught it might well end the whole
532program.
533 514
534=cut 515=cut
535 516
536sub desc { 517sub desc {
537 my $old = $_[0]{desc}; 518 my $old = $_[0]{desc};
639 cede; # for short-lived callbacks, this reduces pressure on the coro pool 620 cede; # for short-lived callbacks, this reduces pressure on the coro pool
640 } 621 }
641 schedule; # sleep well 622 schedule; # sleep well
642 } 623 }
643}; 624};
644$unblock_scheduler->desc ("[unblock_sub scheduler]"); 625$unblock_scheduler->{desc} = "[unblock_sub scheduler]";
645 626
646sub unblock_sub(&) { 627sub unblock_sub(&) {
647 my $cb = shift; 628 my $cb = shift;
648 629
649 sub { 630 sub {
650 unshift @unblock_queue, [$cb, @_]; 631 unshift @unblock_queue, [$cb, @_];
651 $unblock_scheduler->ready; 632 $unblock_scheduler->ready;
652 } 633 }
653} 634}
654 635
636=item $cb = Coro::rouse_cb
637
638Create and return a "rouse callback". That's a code reference that, when
639called, will save its arguments and notify the owner coroutine of the
640callback.
641
642See the next function.
643
644=item @args = Coro::rouse_wait [$cb]
645
646Wait for the specified rouse callback (or the last one tht was created in
647this coroutine).
648
649As soon as the callback is invoked (or when the calback was invoked before
650C<rouse_wait>), it will return a copy of the arguments originally passed
651to the rouse callback.
652
653See the section B<HOW TO WAIT FOR A CALLBACK> for an actual usage example.
654
655=back 655=back
656 656
657=cut 657=cut
658 658
6591; 6591;
660 660
661=head1 HOW TO WAIT FOR A CALLBACK
662
663It is very common for a coroutine to wait for some callback to be
664called. This occurs naturally when you use coroutines in an otherwise
665event-based program, or when you use event-based libraries.
666
667These typically register a callback for some event, and call that callback
668when the event occured. In a coroutine, however, you typically want to
669just wait for the event, simplyifying things.
670
671For example C<< AnyEvent->child >> registers a callback to be called when
672a specific child has exited:
673
674 my $child_watcher = AnyEvent->child (pid => $pid, cb => sub { ... });
675
676But from withina coroutine, you often just want to write this:
677
678 my $status = wait_for_child $pid;
679
680Coro offers two functions specifically designed to make this easy,
681C<Coro::rouse_cb> and C<Coro::rouse_wait>.
682
683The first function, C<rouse_cb>, generates and returns a callback that,
684when invoked, will save it's arguments and notify the coroutine that
685created the callback.
686
687The second function, C<rouse_wait>, waits for the callback to be called
688(by calling C<schedule> to go to sleep) and returns the arguments
689originally passed to the callback.
690
691Using these functions, it becomes easy to write the C<wait_for_child>
692function mentioned above:
693
694 sub wait_for_child($) {
695 my ($pid) = @_;
696
697 my $watcher = AnyEvent->child (pid => $pid, cb => Coro::rouse_cb);
698
699 my ($rpid, $rstatus) = Coro::rouse_wait;
700 $rstatus
701 }
702
703In the case where C<rouse_cb> and C<rouse_wait> are not flexible enough,
704you can roll your own, using C<schedule>:
705
706 sub wait_for_child($) {
707 my ($pid) = @_;
708
709 # store the current coroutine in $current,
710 # and provide result variables for the closure passed to ->child
711 my $current = $Coro::current;
712 my ($done, $rstatus);
713
714 # pass a closure to ->child
715 my $watcher = AnyEvent->child (pid => $pid, cb => sub {
716 $rstatus = $_[1]; # remember rstatus
717 $done = 1; # mark $rstatus as valud
718 });
719
720 # wait until the closure has been called
721 schedule while !$done;
722
723 $rstatus
724 }
725
726
661=head1 BUGS/LIMITATIONS 727=head1 BUGS/LIMITATIONS
728
729=over 4
730
731=item fork with pthread backend
732
733When Coro is compiled using the pthread backend (which isn't recommended
734but required on many BSDs as their libcs are completely broken), then
735coroutines will not survive a fork. There is no known workaround except to
736fix your libc and use a saner backend.
737
738=item perl process emulation ("threads")
662 739
663This module is not perl-pseudo-thread-safe. You should only ever use this 740This module is not perl-pseudo-thread-safe. You should only ever use this
664module from the same thread (this requirement might be removed in the 741module from the same thread (this requirement might be removed in the
665future to allow per-thread schedulers, but Coro::State does not yet allow 742future to allow per-thread schedulers, but Coro::State does not yet allow
666this). I recommend disabling thread support and using processes, as this 743this). I recommend disabling thread support and using processes, as having
667is much faster and uses less memory. 744the windows process emulation enabled under unix roughly halves perl
745performance, even when not used.
746
747=item coroutine switching not signal safe
748
749You must not switch to another coroutine from within a signal handler
750(only relevant with %SIG - most event libraries provide safe signals).
751
752That means you I<MUST NOT> call any function that might "block" the
753current coroutine - C<cede>, C<schedule> C<< Coro::Semaphore->down >> or
754anything that calls those. Everything else, including calling C<ready>,
755works.
756
757=back
758
668 759
669=head1 SEE ALSO 760=head1 SEE ALSO
670 761
671Event-Loop integration: L<Coro::AnyEvent>, L<Coro::EV>, L<Coro::Event>. 762Event-Loop integration: L<Coro::AnyEvent>, L<Coro::EV>, L<Coro::Event>.
672 763

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines