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

Comparing Coro/Coro.pm (file contents):
Revision 1.132 by root, Thu Sep 20 22:53:23 2007 UTC vs.
Revision 1.148 by root, Fri Oct 5 20:11:25 2007 UTC

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.7'; 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);
116=cut 116=cut
117 117
118$main->{desc} = "[main::]"; 118$main->{desc} = "[main::]";
119 119
120# maybe some other module used Coro::Specific before... 120# maybe some other module used Coro::Specific before...
121$main->{specific} = $current->{specific} 121$main->{_specific} = $current->{_specific}
122 if $current; 122 if $current;
123 123
124_set_current $main; 124_set_current $main;
125 125
126sub current() { $current } 126sub current() { $current }
151 # free coroutine data and mark as destructed 151 # free coroutine data and mark as destructed
152 $self->_destroy 152 $self->_destroy
153 or return; 153 or return;
154 154
155 # call all destruction callbacks 155 # call all destruction callbacks
156 $_->(@{$self->{status}}) 156 $_->(@{$self->{_status}})
157 for @{(delete $self->{destroy_cb}) || []}; 157 for @{(delete $self->{_on_destroy}) || []};
158} 158}
159 159
160# this coroutine is necessary because a coroutine 160# this coroutine is necessary because a coroutine
161# cannot destroy itself. 161# cannot destroy itself.
162my @destroy; 162my @destroy;
186=item async { ... } [@args...] 186=item async { ... } [@args...]
187 187
188Create a new asynchronous coroutine and return it's coroutine object 188Create a new asynchronous coroutine and return it's coroutine object
189(usually unused). When the sub returns the new coroutine is automatically 189(usually unused). When the sub returns the new coroutine is automatically
190terminated. 190terminated.
191
192See the C<Coro::State::new> constructor for info about the coroutine
193environment.
191 194
192Calling C<exit> in a coroutine will do the same as calling exit outside 195Calling C<exit> in a coroutine will do the same as calling exit outside
193the coroutine. Likewise, when the coroutine dies, the program will exit, 196the coroutine. Likewise, when the coroutine dies, the program will exit,
194just as it would in the main program. 197just as it would in the main program.
195 198
216issued in case of an exception instead of terminating the program, as 219issued in case of an exception instead of terminating the program, as
217C<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>
218will 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,
219which somehow defeats the purpose of pooling. 222which somehow defeats the purpose of pooling.
220 223
221The 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
222will 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 $/ >.
223 230
224The 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
225changing $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
226required. 233required.
227 234
228If you are concerned about pooled coroutines growing a lot because a 235If you are concerned about pooled coroutines growing a lot because a
229single 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
230terminate }> 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.
231 240
232=cut 241=cut
233 242
234our $POOL_SIZE = 8; 243our $POOL_SIZE = 8;
235our $MAX_POOL_RSS = 64 * 1024; 244our $POOL_RSS = 16 * 1024;
236our @pool; 245our @async_pool;
237 246
238sub pool_handler { 247sub pool_handler {
248 my $cb;
249
239 while () { 250 while () {
240 $current->{desc} = "[async_pool]";
241
242 eval { 251 eval {
243 my ($cb, @arg) = @{ delete $current->{_invoke} or return }; 252 while () {
244 $cb->(@arg); 253 _pool_1 $cb;
254 &$cb;
255 _pool_2 $cb;
256 &schedule;
257 }
245 }; 258 };
259
260 last if $@ eq "\3terminate\2\n";
246 warn $@ if $@; 261 warn $@ if $@;
247
248 last if @pool >= $POOL_SIZE || $current->rss >= $MAX_POOL_RSS;
249
250 push @pool, $current;
251 $current->{desc} = "[async_pool idle]";
252 $current->save (Coro::State::SAVE_DEF);
253 $current->prio (0);
254 schedule;
255 } 262 }
256} 263}
257 264
258sub async_pool(&@) { 265sub async_pool(&@) {
259 # this is also inlined into the unlock_scheduler 266 # this is also inlined into the unlock_scheduler
260 my $coro = (pop @pool) || new Coro \&pool_handler;; 267 my $coro = (pop @async_pool) || new Coro \&pool_handler;
261 268
262 $coro->{_invoke} = [@_]; 269 $coro->{_invoke} = [@_];
263 $coro->ready; 270 $coro->ready;
264 271
265 $coro 272 $coro
308 315
309=item terminate [arg...] 316=item terminate [arg...]
310 317
311Terminates the current coroutine with the given status values (see L<cancel>). 318Terminates the current coroutine with the given status values (see L<cancel>).
312 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
313=cut 326=cut
314 327
315sub terminate { 328sub terminate {
316 $current->cancel (@_); 329 $current->cancel (@_);
330}
331
332sub killall {
333 for (Coro::State::list) {
334 $_->cancel
335 if $_ != $current && UNIVERSAL::isa $_, "Coro";
336 }
317} 337}
318 338
319=back 339=back
320 340
321# dynamic methods 341# dynamic methods
331Create 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
332automatically terminates as if C<terminate> with the returned values were 352automatically terminates as if C<terminate> with the returned values were
333called. 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
334by calling the ready method. 354by calling the ready method.
335 355
336See C<async> for additional discussion. 356See C<async> and C<Coro::State::new> for additional info about the
357coroutine environment.
337 358
338=cut 359=cut
339 360
340sub _run_coro { 361sub _run_coro {
341 terminate &{+shift}; 362 terminate &{+shift};
365 386
366=cut 387=cut
367 388
368sub cancel { 389sub cancel {
369 my $self = shift; 390 my $self = shift;
370 $self->{status} = [@_]; 391 $self->{_status} = [@_];
371 392
372 if ($current == $self) { 393 if ($current == $self) {
373 push @destroy, $self; 394 push @destroy, $self;
374 $manager->ready; 395 $manager->ready;
375 &schedule while 1; 396 &schedule while 1;
379} 400}
380 401
381=item $coroutine->join 402=item $coroutine->join
382 403
383Wait until the coroutine terminates and return any values given to the 404Wait until the coroutine terminates and return any values given to the
384C<terminate> or C<cancel> functions. C<join> can be called multiple times 405C<terminate> or C<cancel> functions. C<join> can be called concurrently
385from multiple coroutine. 406from multiple coroutines.
386 407
387=cut 408=cut
388 409
389sub join { 410sub join {
390 my $self = shift; 411 my $self = shift;
391 412
392 unless ($self->{status}) { 413 unless ($self->{_status}) {
393 my $current = $current; 414 my $current = $current;
394 415
395 push @{$self->{destroy_cb}}, sub { 416 push @{$self->{_on_destroy}}, sub {
396 $current->ready; 417 $current->ready;
397 undef $current; 418 undef $current;
398 }; 419 };
399 420
400 &schedule while $current; 421 &schedule while $current;
401 } 422 }
402 423
403 wantarray ? @{$self->{status}} : $self->{status}[0]; 424 wantarray ? @{$self->{_status}} : $self->{_status}[0];
404} 425}
405 426
406=item $coroutine->on_destroy (\&cb) 427=item $coroutine->on_destroy (\&cb)
407 428
408Registers a callback that is called when this coroutine gets destroyed, 429Registers a callback that is called when this coroutine gets destroyed,
412=cut 433=cut
413 434
414sub on_destroy { 435sub on_destroy {
415 my ($self, $cb) = @_; 436 my ($self, $cb) = @_;
416 437
417 push @{ $self->{destroy_cb} }, $cb; 438 push @{ $self->{_on_destroy} }, $cb;
418} 439}
419 440
420=item $oldprio = $coroutine->prio ($newprio) 441=item $oldprio = $coroutine->prio ($newprio)
421 442
422Sets (or gets, if the argument is missing) the priority of the 443Sets (or gets, if the argument is missing) the priority of the
446 467
447=item $olddesc = $coroutine->desc ($newdesc) 468=item $olddesc = $coroutine->desc ($newdesc)
448 469
449Sets (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
450coroutine. 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.
472
473This method simply sets the C<< $coroutine->{desc} >> member to the given string. You
474can modify this member directly if you wish.
451 475
452=cut 476=cut
453 477
454sub desc { 478sub desc {
455 my $old = $_[0]{desc}; 479 my $old = $_[0]{desc};
535# inside an event callback. 559# inside an event callback.
536our $unblock_scheduler = new Coro sub { 560our $unblock_scheduler = new Coro sub {
537 while () { 561 while () {
538 while (my $cb = pop @unblock_queue) { 562 while (my $cb = pop @unblock_queue) {
539 # this is an inlined copy of async_pool 563 # this is an inlined copy of async_pool
540 my $coro = (pop @pool or new Coro \&pool_handler); 564 my $coro = (pop @async_pool) || new Coro \&pool_handler;
541 565
542 $coro->{_invoke} = $cb; 566 $coro->{_invoke} = $cb;
543 $coro->ready; 567 $coro->ready;
544 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
545 } 569 }
573 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
574 this). 598 this).
575 599
576=head1 SEE ALSO 600=head1 SEE ALSO
577 601
578Support/Utility: L<Coro::Cont>, L<Coro::Specific>, L<Coro::State>, L<Coro::Util>. 602Support/Utility: L<Coro::Specific>, L<Coro::State>, L<Coro::Util>.
579 603
580Locking/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>.
581 605
582Event/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>.
583 607

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines