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

Comparing Coro/Coro.pm (file contents):
Revision 1.113 by root, Tue Jan 23 15:55:45 2007 UTC vs.
Revision 1.148 by root, Fri Oct 5 20:11:25 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.42'; 55our $VERSION = '4.01';
56 56
57our @EXPORT = qw(async async_pool 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);
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$main->{desc} = "[main::]";
119
118# maybe some other module used Coro::Specific before... 120# maybe some other module used Coro::Specific before...
119$main->{specific} = $current->{specific} 121$main->{_specific} = $current->{_specific}
120 if $current; 122 if $current;
121 123
122_set_current $main; 124_set_current $main;
123 125
124sub current() { $current } 126sub current() { $current }
149 # free coroutine data and mark as destructed 151 # free coroutine data and mark as destructed
150 $self->_destroy 152 $self->_destroy
151 or return; 153 or return;
152 154
153 # call all destruction callbacks 155 # call all destruction callbacks
154 $_->(@{$self->{status}}) 156 $_->(@{$self->{_status}})
155 for @{(delete $self->{destroy_cb}) || []}; 157 for @{(delete $self->{_on_destroy}) || []};
156} 158}
157 159
158# this coroutine is necessary because a coroutine 160# this coroutine is necessary because a coroutine
159# cannot destroy itself. 161# cannot destroy itself.
160my @destroy; 162my @destroy;
166 while @destroy; 168 while @destroy;
167 169
168 &schedule; 170 &schedule;
169 } 171 }
170}; 172};
171 173$manager->desc ("[coro manager]");
172$manager->prio (PRIO_MAX); 174$manager->prio (PRIO_MAX);
173 175
174# static methods. not really. 176# static methods. not really.
175 177
176=back 178=back
185 187
186Create a new asynchronous coroutine and return it's coroutine object 188Create a new asynchronous coroutine and return it's coroutine object
187(usually unused). When the sub returns the new coroutine is automatically 189(usually unused). When the sub returns the new coroutine is automatically
188terminated. 190terminated.
189 191
190Calling C<exit> in a coroutine will not work correctly, so do not do that. 192See the C<Coro::State::new> constructor for info about the coroutine
193environment.
191 194
192When the coroutine dies, the program will exit, just as in the main 195Calling C<exit> in a coroutine will do the same as calling exit outside
193program. 196the coroutine. Likewise, when the coroutine dies, the program will exit,
197just as it would in the main program.
194 198
195 # create a new coroutine that just prints its arguments 199 # create a new coroutine that just prints its arguments
196 async { 200 async {
197 print "@_\n"; 201 print "@_\n";
198 } 1,2,3,4; 202 } 1,2,3,4;
215issued in case of an exception instead of terminating the program, as 219issued in case of an exception instead of terminating the program, as
216C<async> does. As the coroutine is being reused, stuff like C<on_destroy> 220C<async> does. As the coroutine is being reused, stuff like C<on_destroy>
217will not work in the expected way, unless you call terminate or cancel, 221will not work in the expected way, unless you call terminate or cancel,
218which somehow defeats the purpose of pooling. 222which somehow defeats the purpose of pooling.
219 223
220The priority will be reset to C<0> after each job, otherwise the coroutine 224The priority will be reset to C<0> after each job, tracing will be
221will be re-used "as-is". 225disabled, the description will be reset and the default output filehandle
226gets restored, so you can change alkl these. Otherwise the coroutine will
227be re-used "as-is": most notably if you change other per-coroutine global
228stuff such as C<$/> you need to revert that change, which is most simply
229done by using local as in C< local $/ >.
222 230
223The pool size is limited to 8 idle coroutines (this can be adjusted by 231The pool size is limited to 8 idle coroutines (this can be adjusted by
224changing $Coro::POOL_SIZE), and there can be as many non-idle coros as 232changing $Coro::POOL_SIZE), and there can be as many non-idle coros as
225required. 233required.
226 234
227If you are concerned about pooled coroutines growing a lot because a 235If you are concerned about pooled coroutines growing a lot because a
228single C<async_pool> used a lot of stackspace you can e.g. C<async_pool { 236single C<async_pool> used a lot of stackspace you can e.g. C<async_pool
229terminate }> once per second or so to slowly replenish the pool. 237{ terminate }> once per second or so to slowly replenish the pool. In
238addition to that, when the stacks used by a handler grows larger than 16kb
239(adjustable with $Coro::POOL_RSS) it will also exit.
230 240
231=cut 241=cut
232 242
233our $POOL_SIZE = 8; 243our $POOL_SIZE = 8;
244our $POOL_RSS = 16 * 1024;
234our @pool; 245our @async_pool;
235 246
236sub pool_handler { 247sub pool_handler {
248 my $cb;
249
237 while () { 250 while () {
238 eval { 251 eval {
239 my ($cb, @arg) = @{ delete $current->{_invoke} or return }; 252 while () {
240 $cb->(@arg); 253 _pool_1 $cb;
254 &$cb;
255 _pool_2 $cb;
256 &schedule;
257 }
241 }; 258 };
259
260 last if $@ eq "\3terminate\2\n";
242 warn $@ if $@; 261 warn $@ if $@;
243
244 last if @pool >= $POOL_SIZE;
245 push @pool, $current;
246
247 $current->prio (0);
248 schedule;
249 } 262 }
250} 263}
251 264
252sub async_pool(&@) { 265sub async_pool(&@) {
253 # this is also inlined into the unlock_scheduler 266 # this is also inlined into the unlock_scheduler
254 my $coro = (pop @pool or new Coro \&pool_handler); 267 my $coro = (pop @async_pool) || new Coro \&pool_handler;
255 268
256 $coro->{_invoke} = [@_]; 269 $coro->{_invoke} = [@_];
257 $coro->ready; 270 $coro->ready;
258 271
259 $coro 272 $coro
277 # wake up sleeping coroutine 290 # wake up sleeping coroutine
278 $current->ready; 291 $current->ready;
279 undef $current; 292 undef $current;
280 }; 293 };
281 294
282 # call schedule until event occured. 295 # call schedule until event occurred.
283 # in case we are woken up for other reasons 296 # in case we are woken up for other reasons
284 # (current still defined), loop. 297 # (current still defined), loop.
285 Coro::schedule while $current; 298 Coro::schedule while $current;
286 } 299 }
287 300
302 315
303=item terminate [arg...] 316=item terminate [arg...]
304 317
305Terminates the current coroutine with the given status values (see L<cancel>). 318Terminates the current coroutine with the given status values (see L<cancel>).
306 319
320=item killall
321
322Kills/terminates/cancels all coroutines except the currently running
323one. This is useful after a fork, either in the child or the parent, as
324usually only one of them should inherit the running coroutines.
325
307=cut 326=cut
308 327
309sub terminate { 328sub terminate {
310 $current->cancel (@_); 329 $current->cancel (@_);
330}
331
332sub killall {
333 for (Coro::State::list) {
334 $_->cancel
335 if $_ != $current && UNIVERSAL::isa $_, "Coro";
336 }
311} 337}
312 338
313=back 339=back
314 340
315# dynamic methods 341# dynamic methods
325Create a new coroutine and return it. When the sub returns the coroutine 351Create a new coroutine and return it. When the sub returns the coroutine
326automatically terminates as if C<terminate> with the returned values were 352automatically terminates as if C<terminate> with the returned values were
327called. To make the coroutine run you must first put it into the ready queue 353called. To make the coroutine run you must first put it into the ready queue
328by calling the ready method. 354by calling the ready method.
329 355
330Calling C<exit> in a coroutine will not work correctly, so do not do that. 356See C<async> and C<Coro::State::new> for additional info about the
357coroutine environment.
331 358
332=cut 359=cut
333 360
334sub _run_coro { 361sub _run_coro {
335 terminate &{+shift}; 362 terminate &{+shift};
359 386
360=cut 387=cut
361 388
362sub cancel { 389sub cancel {
363 my $self = shift; 390 my $self = shift;
364 $self->{status} = [@_]; 391 $self->{_status} = [@_];
365 392
366 if ($current == $self) { 393 if ($current == $self) {
367 push @destroy, $self; 394 push @destroy, $self;
368 $manager->ready; 395 $manager->ready;
369 &schedule while 1; 396 &schedule while 1;
373} 400}
374 401
375=item $coroutine->join 402=item $coroutine->join
376 403
377Wait until the coroutine terminates and return any values given to the 404Wait until the coroutine terminates and return any values given to the
378C<terminate> or C<cancel> functions. C<join> can be called multiple times 405C<terminate> or C<cancel> functions. C<join> can be called concurrently
379from multiple coroutine. 406from multiple coroutines.
380 407
381=cut 408=cut
382 409
383sub join { 410sub join {
384 my $self = shift; 411 my $self = shift;
385 412
386 unless ($self->{status}) { 413 unless ($self->{_status}) {
387 my $current = $current; 414 my $current = $current;
388 415
389 push @{$self->{destroy_cb}}, sub { 416 push @{$self->{_on_destroy}}, sub {
390 $current->ready; 417 $current->ready;
391 undef $current; 418 undef $current;
392 }; 419 };
393 420
394 &schedule while $current; 421 &schedule while $current;
395 } 422 }
396 423
397 wantarray ? @{$self->{status}} : $self->{status}[0]; 424 wantarray ? @{$self->{_status}} : $self->{_status}[0];
398} 425}
399 426
400=item $coroutine->on_destroy (\&cb) 427=item $coroutine->on_destroy (\&cb)
401 428
402Registers a callback that is called when this coroutine gets destroyed, 429Registers a callback that is called when this coroutine gets destroyed,
406=cut 433=cut
407 434
408sub on_destroy { 435sub on_destroy {
409 my ($self, $cb) = @_; 436 my ($self, $cb) = @_;
410 437
411 push @{ $self->{destroy_cb} }, $cb; 438 push @{ $self->{_on_destroy} }, $cb;
412} 439}
413 440
414=item $oldprio = $coroutine->prio ($newprio) 441=item $oldprio = $coroutine->prio ($newprio)
415 442
416Sets (or gets, if the argument is missing) the priority of the 443Sets (or gets, if the argument is missing) the priority of the
441=item $olddesc = $coroutine->desc ($newdesc) 468=item $olddesc = $coroutine->desc ($newdesc)
442 469
443Sets (or gets in case the argument is missing) the description for this 470Sets (or gets in case the argument is missing) the description for this
444coroutine. This is just a free-form string you can associate with a coroutine. 471coroutine. This is just a free-form string you can associate with a coroutine.
445 472
473This method simply sets the C<< $coroutine->{desc} >> member to the given string. You
474can modify this member directly if you wish.
475
446=cut 476=cut
447 477
448sub desc { 478sub desc {
449 my $old = $_[0]{desc}; 479 my $old = $_[0]{desc};
450 $_[0]{desc} = $_[1] if @_ > 1; 480 $_[0]{desc} = $_[1] if @_ > 1;
458=over 4 488=over 4
459 489
460=item Coro::nready 490=item Coro::nready
461 491
462Returns the number of coroutines that are currently in the ready state, 492Returns the number of coroutines that are currently in the ready state,
463i.e. that can be swicthed to. The value C<0> means that the only runnable 493i.e. that can be switched to. The value C<0> means that the only runnable
464coroutine is the currently running one, so C<cede> would have no effect, 494coroutine is the currently running one, so C<cede> would have no effect,
465and C<schedule> would cause a deadlock unless there is an idle handler 495and C<schedule> would cause a deadlock unless there is an idle handler
466that wakes up some coroutines. 496that wakes up some coroutines.
467 497
468=item my $guard = Coro::guard { ... } 498=item my $guard = Coro::guard { ... }
469 499
470This creates and returns a guard object. Nothing happens until the objetc 500This creates and returns a guard object. Nothing happens until the object
471gets destroyed, in which case the codeblock given as argument will be 501gets destroyed, in which case the codeblock given as argument will be
472executed. This is useful to free locks or other resources in case of a 502executed. This is useful to free locks or other resources in case of a
473runtime error or when the coroutine gets canceled, as in both cases the 503runtime error or when the coroutine gets canceled, as in both cases the
474guard block will be executed. The guard object supports only one method, 504guard block will be executed. The guard object supports only one method,
475C<< ->cancel >>, which will keep the codeblock from being executed. 505C<< ->cancel >>, which will keep the codeblock from being executed.
504This utility function takes a BLOCK or code reference and "unblocks" it, 534This utility function takes a BLOCK or code reference and "unblocks" it,
505returning the new coderef. This means that the new coderef will return 535returning the new coderef. This means that the new coderef will return
506immediately without blocking, returning nothing, while the original code 536immediately without blocking, returning nothing, while the original code
507ref will be called (with parameters) from within its own coroutine. 537ref will be called (with parameters) from within its own coroutine.
508 538
509The reason this fucntion exists is that many event libraries (such as the 539The reason this function exists is that many event libraries (such as the
510venerable L<Event|Event> module) are not coroutine-safe (a weaker form 540venerable L<Event|Event> module) are not coroutine-safe (a weaker form
511of thread-safety). This means you must not block within event callbacks, 541of thread-safety). This means you must not block within event callbacks,
512otherwise you might suffer from crashes or worse. 542otherwise you might suffer from crashes or worse.
513 543
514This function allows your callbacks to block by executing them in another 544This function allows your callbacks to block by executing them in another
525 555
526# we create a special coro because we want to cede, 556# we create a special coro because we want to cede,
527# to reduce pressure on the coro pool (because most callbacks 557# to reduce pressure on the coro pool (because most callbacks
528# return immediately and can be reused) and because we cannot cede 558# return immediately and can be reused) and because we cannot cede
529# inside an event callback. 559# inside an event callback.
530our $unblock_scheduler = async { 560our $unblock_scheduler = new Coro sub {
531 while () { 561 while () {
532 while (my $cb = pop @unblock_queue) { 562 while (my $cb = pop @unblock_queue) {
533 # this is an inlined copy of async_pool 563 # this is an inlined copy of async_pool
534 my $coro = (pop @pool or new Coro \&pool_handler); 564 my $coro = (pop @async_pool) || new Coro \&pool_handler;
535 565
536 $coro->{_invoke} = $cb; 566 $coro->{_invoke} = $cb;
537 $coro->ready; 567 $coro->ready;
538 cede; # for short-lived callbacks, this reduces pressure on the coro pool 568 cede; # for short-lived callbacks, this reduces pressure on the coro pool
539 } 569 }
540 schedule; # sleep well 570 schedule; # sleep well
541 } 571 }
542}; 572};
573$unblock_scheduler->desc ("[unblock_sub scheduler]");
543 574
544sub unblock_sub(&) { 575sub unblock_sub(&) {
545 my $cb = shift; 576 my $cb = shift;
546 577
547 sub { 578 sub {
560 591
561 - you must make very sure that no coro is still active on global 592 - you must make very sure that no coro is still active on global
562 destruction. very bad things might happen otherwise (usually segfaults). 593 destruction. very bad things might happen otherwise (usually segfaults).
563 594
564 - this module is not thread-safe. You should only ever use this module 595 - this module is not thread-safe. You should only ever use this module
565 from the same thread (this requirement might be losened in the future 596 from the same thread (this requirement might be loosened in the future
566 to allow per-thread schedulers, but Coro::State does not yet allow 597 to allow per-thread schedulers, but Coro::State does not yet allow
567 this). 598 this).
568 599
569=head1 SEE ALSO 600=head1 SEE ALSO
570 601
571Support/Utility: L<Coro::Cont>, L<Coro::Specific>, L<Coro::State>, L<Coro::Util>. 602Support/Utility: L<Coro::Specific>, L<Coro::State>, L<Coro::Util>.
572 603
573Locking/IPC: L<Coro::Signal>, L<Coro::Channel>, L<Coro::Semaphore>, L<Coro::SemaphoreSet>, L<Coro::RWLock>. 604Locking/IPC: L<Coro::Signal>, L<Coro::Channel>, L<Coro::Semaphore>, L<Coro::SemaphoreSet>, L<Coro::RWLock>.
574 605
575Event/IO: L<Coro::Timer>, L<Coro::Event>, L<Coro::Handle>, L<Coro::Socket>, L<Coro::Select>. 606Event/IO: L<Coro::Timer>, L<Coro::Event>, L<Coro::Handle>, L<Coro::Socket>, L<Coro::Select>.
576 607

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines