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

Comparing Coro/Coro.pm (file contents):
Revision 1.103 by root, Thu Jan 4 20:14:19 2007 UTC vs.
Revision 1.128 by root, Wed Sep 19 21:39:15 2007 UTC

20 20
21=head1 DESCRIPTION 21=head1 DESCRIPTION
22 22
23This module collection manages coroutines. Coroutines are similar 23This module collection manages coroutines. Coroutines are similar
24to threads but don't run in parallel at the same time even on SMP 24to threads but don't run in parallel at the same time even on SMP
25machines. The specific flavor of coroutine use din this module also 25machines. The specific flavor of coroutine used in this module also
26guarentees you that it will not switch between coroutines unless 26guarantees you that it will not switch between coroutines unless
27necessary, at easily-identified points in your program, so locking and 27necessary, at easily-identified points in your program, so locking and
28parallel access are rarely an issue, making coroutine programming much 28parallel access are rarely an issue, making coroutine programming much
29safer than threads programming. 29safer than threads programming.
30 30
31(Perl, however, does not natively support real threads but instead does a 31(Perl, however, does not natively support real threads but instead does a
50 50
51our $idle; # idle handler 51our $idle; # idle handler
52our $main; # main coroutine 52our $main; # main coroutine
53our $current; # current coroutine 53our $current; # current coroutine
54 54
55our $VERSION = '3.3'; 55our $VERSION = '3.7';
56 56
57our @EXPORT = qw(async cede schedule terminate current unblock_sub); 57our @EXPORT = qw(async async_pool cede schedule terminate current unblock_sub);
58our %EXPORT_TAGS = ( 58our %EXPORT_TAGS = (
59 prio => [qw(PRIO_MAX PRIO_HIGH PRIO_NORMAL PRIO_LOW PRIO_IDLE PRIO_MIN)], 59 prio => [qw(PRIO_MAX PRIO_HIGH PRIO_NORMAL PRIO_LOW PRIO_IDLE PRIO_MIN)],
60); 60);
61our @EXPORT_OK = (@{$EXPORT_TAGS{prio}}, qw(nready)); 61our @EXPORT_OK = (@{$EXPORT_TAGS{prio}}, qw(nready));
62 62
108 108
109The current coroutine (the last coroutine switched to). The initial value 109The current coroutine (the last coroutine switched to). The initial value
110is C<$main> (of course). 110is C<$main> (of course).
111 111
112This variable is B<strictly> I<read-only>. It is provided for performance 112This variable is B<strictly> I<read-only>. It is provided for performance
113reasons. If performance is not essentiel you are encouraged to use the 113reasons. If performance is not essential you are encouraged to use the
114C<Coro::current> function instead. 114C<Coro::current> function instead.
115 115
116=cut 116=cut
117 117
118# maybe some other module used Coro::Specific before... 118# maybe some other module used Coro::Specific before...
185 185
186Create a new asynchronous coroutine and return it's coroutine object 186Create a new asynchronous coroutine and return it's coroutine object
187(usually unused). When the sub returns the new coroutine is automatically 187(usually unused). When the sub returns the new coroutine is automatically
188terminated. 188terminated.
189 189
190Calling C<exit> in a coroutine will not work correctly, so do not do that. 190Calling C<exit> in a coroutine will do the same as calling exit outside
191 191the coroutine. Likewise, when the coroutine dies, the program will exit,
192When the coroutine dies, the program will exit, just as in the main 192just as it would in the main program.
193program.
194 193
195 # create a new coroutine that just prints its arguments 194 # create a new coroutine that just prints its arguments
196 async { 195 async {
197 print "@_\n"; 196 print "@_\n";
198 } 1,2,3,4; 197 } 1,2,3,4;
199 198
200=cut 199=cut
201 200
202sub async(&@) { 201sub async(&@) {
203 my $pid = new Coro @_; 202 my $coro = new Coro @_;
204 $pid->ready; 203 $coro->ready;
205 $pid 204 $coro
205}
206
207=item async_pool { ... } [@args...]
208
209Similar to C<async>, but uses a coroutine pool, so you should not call
210terminate or join (although you are allowed to), and you get a coroutine
211that might have executed other code already (which can be good or bad :).
212
213Also, the block is executed in an C<eval> context and a warning will be
214issued in case of an exception instead of terminating the program, as
215C<async> does. As the coroutine is being reused, stuff like C<on_destroy>
216will not work in the expected way, unless you call terminate or cancel,
217which somehow defeats the purpose of pooling.
218
219The priority will be reset to C<0> after each job, otherwise the coroutine
220will be re-used "as-is".
221
222The pool size is limited to 8 idle coroutines (this can be adjusted by
223changing $Coro::POOL_SIZE), and there can be as many non-idle coros as
224required.
225
226If you are concerned about pooled coroutines growing a lot because a
227single C<async_pool> used a lot of stackspace you can e.g. C<async_pool {
228terminate }> once per second or so to slowly replenish the pool.
229
230=cut
231
232our $POOL_SIZE = 8;
233our @pool;
234
235sub pool_handler {
236 while () {
237 eval {
238 my ($cb, @arg) = @{ delete $current->{_invoke} or return };
239 $cb->(@arg);
240 };
241 warn $@ if $@;
242
243 last if @pool >= $POOL_SIZE;
244 push @pool, $current;
245
246 $current->save (Coro::State::SAVE_DEF);
247 $current->prio (0);
248 schedule;
249 }
250}
251
252sub async_pool(&@) {
253 # this is also inlined into the unlock_scheduler
254 my $coro = (pop @pool) || do {
255 my $coro = new Coro \&pool_handler;
256 $coro->{desc} = "async_pool";
257 $coro
258 };
259
260 $coro->{_invoke} = [@_];
261 $coro->ready;
262
263 $coro
206} 264}
207 265
208=item schedule 266=item schedule
209 267
210Calls the scheduler. Please note that the current coroutine will not be put 268Calls the scheduler. Please note that the current coroutine will not be put
223 # wake up sleeping coroutine 281 # wake up sleeping coroutine
224 $current->ready; 282 $current->ready;
225 undef $current; 283 undef $current;
226 }; 284 };
227 285
228 # call schedule until event occured. 286 # call schedule until event occurred.
229 # in case we are woken up for other reasons 287 # in case we are woken up for other reasons
230 # (current still defined), loop. 288 # (current still defined), loop.
231 Coro::schedule while $current; 289 Coro::schedule while $current;
232 } 290 }
233 291
235 293
236"Cede" to other coroutines. This function puts the current coroutine into the 294"Cede" to other coroutines. This function puts the current coroutine into the
237ready queue and calls C<schedule>, which has the effect of giving up the 295ready queue and calls C<schedule>, which has the effect of giving up the
238current "timeslice" to other coroutines of the same or higher priority. 296current "timeslice" to other coroutines of the same or higher priority.
239 297
298Returns true if at least one coroutine switch has happened.
299
240=item Coro::cede_notself 300=item Coro::cede_notself
241 301
242Works like cede, but is not exported by default and will cede to any 302Works like cede, but is not exported by default and will cede to any
243coroutine, regardless of priority, once. 303coroutine, regardless of priority, once.
304
305Returns true if at least one coroutine switch has happened.
244 306
245=item terminate [arg...] 307=item terminate [arg...]
246 308
247Terminates the current coroutine with the given status values (see L<cancel>). 309Terminates the current coroutine with the given status values (see L<cancel>).
248 310
267Create a new coroutine and return it. When the sub returns the coroutine 329Create a new coroutine and return it. When the sub returns the coroutine
268automatically terminates as if C<terminate> with the returned values were 330automatically terminates as if C<terminate> with the returned values were
269called. To make the coroutine run you must first put it into the ready queue 331called. To make the coroutine run you must first put it into the ready queue
270by calling the ready method. 332by calling the ready method.
271 333
272Calling C<exit> in a coroutine will not work correctly, so do not do that. 334See C<async> for additional discussion.
273 335
274=cut 336=cut
275 337
276sub _run_coro { 338sub _run_coro {
277 terminate &{+shift}; 339 terminate &{+shift};
400=over 4 462=over 4
401 463
402=item Coro::nready 464=item Coro::nready
403 465
404Returns the number of coroutines that are currently in the ready state, 466Returns the number of coroutines that are currently in the ready state,
405i.e. that can be swicthed to. The value C<0> means that the only runnable 467i.e. that can be switched to. The value C<0> means that the only runnable
406coroutine is the currently running one, so C<cede> would have no effect, 468coroutine is the currently running one, so C<cede> would have no effect,
407and C<schedule> would cause a deadlock unless there is an idle handler 469and C<schedule> would cause a deadlock unless there is an idle handler
408that wakes up some coroutines. 470that wakes up some coroutines.
409 471
410=item my $guard = Coro::guard { ... } 472=item my $guard = Coro::guard { ... }
411 473
412This creates and returns a guard object. Nothing happens until the objetc 474This creates and returns a guard object. Nothing happens until the object
413gets destroyed, in which case the codeblock given as argument will be 475gets destroyed, in which case the codeblock given as argument will be
414executed. This is useful to free locks or other resources in case of a 476executed. This is useful to free locks or other resources in case of a
415runtime error or when the coroutine gets canceled, as in both cases the 477runtime error or when the coroutine gets canceled, as in both cases the
416guard block will be executed. The guard object supports only one method, 478guard block will be executed. The guard object supports only one method,
417C<< ->cancel >>, which will keep the codeblock from being executed. 479C<< ->cancel >>, which will keep the codeblock from being executed.
446This utility function takes a BLOCK or code reference and "unblocks" it, 508This utility function takes a BLOCK or code reference and "unblocks" it,
447returning the new coderef. This means that the new coderef will return 509returning the new coderef. This means that the new coderef will return
448immediately without blocking, returning nothing, while the original code 510immediately without blocking, returning nothing, while the original code
449ref will be called (with parameters) from within its own coroutine. 511ref will be called (with parameters) from within its own coroutine.
450 512
451The reason this fucntion exists is that many event libraries (such as the 513The reason this function exists is that many event libraries (such as the
452venerable L<Event|Event> module) are not coroutine-safe (a weaker form 514venerable L<Event|Event> module) are not coroutine-safe (a weaker form
453of thread-safety). This means you must not block within event callbacks, 515of thread-safety). This means you must not block within event callbacks,
454otherwise you might suffer from crashes or worse. 516otherwise you might suffer from crashes or worse.
455 517
456This function allows your callbacks to block by executing them in another 518This function allows your callbacks to block by executing them in another
461In short: simply use C<unblock_sub { ... }> instead of C<sub { ... }> when 523In short: simply use C<unblock_sub { ... }> instead of C<sub { ... }> when
462creating event callbacks that want to block. 524creating event callbacks that want to block.
463 525
464=cut 526=cut
465 527
466our @unblock_pool;
467our @unblock_queue; 528our @unblock_queue;
468our $UNBLOCK_POOL_SIZE = 2;
469 529
470sub unblock_handler_ { 530# we create a special coro because we want to cede,
471 while () { 531# to reduce pressure on the coro pool (because most callbacks
472 my ($cb, @arg) = @{ delete $Coro::current->{arg} }; 532# return immediately and can be reused) and because we cannot cede
473 $cb->(@arg); 533# inside an event callback.
474
475 last if @unblock_pool >= $UNBLOCK_POOL_SIZE;
476 push @unblock_pool, $Coro::current;
477 schedule;
478 }
479}
480
481our $unblock_scheduler = async { 534our $unblock_scheduler = async {
482 while () { 535 while () {
483 while (my $cb = pop @unblock_queue) { 536 while (my $cb = pop @unblock_queue) {
537 # this is an inlined copy of async_pool
484 my $handler = (pop @unblock_pool or new Coro \&unblock_handler_); 538 my $coro = (pop @pool or new Coro \&pool_handler);
485 $handler->{arg} = $cb; 539
540 $coro->{_invoke} = $cb;
486 $handler->ready; 541 $coro->ready;
487 cede; 542 cede; # for short-lived callbacks, this reduces pressure on the coro pool
488 } 543 }
489 544 schedule; # sleep well
490 schedule;
491 } 545 }
492}; 546};
493 547
494sub unblock_sub(&) { 548sub unblock_sub(&) {
495 my $cb = shift; 549 my $cb = shift;
496 550
497 sub { 551 sub {
498 push @unblock_queue, [$cb, @_]; 552 unshift @unblock_queue, [$cb, @_];
499 $unblock_scheduler->ready; 553 $unblock_scheduler->ready;
500 } 554 }
501} 555}
502 556
503=back 557=back
510 564
511 - you must make very sure that no coro is still active on global 565 - you must make very sure that no coro is still active on global
512 destruction. very bad things might happen otherwise (usually segfaults). 566 destruction. very bad things might happen otherwise (usually segfaults).
513 567
514 - this module is not thread-safe. You should only ever use this module 568 - this module is not thread-safe. You should only ever use this module
515 from the same thread (this requirement might be losened in the future 569 from the same thread (this requirement might be loosened in the future
516 to allow per-thread schedulers, but Coro::State does not yet allow 570 to allow per-thread schedulers, but Coro::State does not yet allow
517 this). 571 this).
518 572
519=head1 SEE ALSO 573=head1 SEE ALSO
520 574

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines