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

Comparing Coro/Coro.pm (file contents):
Revision 1.131 by root, Thu Sep 20 12:24:42 2007 UTC vs.
Revision 1.142 by root, Tue Oct 2 23:16:24 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 = '3.8';
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;
163my $manager; 163my $manager;
164 164
165$manager = new Coro sub { 165$manager = new Coro sub {
166 $current->desc ("[coro manager]");
167
168 while () { 166 while () {
169 (shift @destroy)->_cancel 167 (shift @destroy)->_cancel
170 while @destroy; 168 while @destroy;
171 169
172 &schedule; 170 &schedule;
173 } 171 }
174}; 172};
175 173$manager->desc ("[coro manager]");
176$manager->prio (PRIO_MAX); 174$manager->prio (PRIO_MAX);
177 175
178# static methods. not really. 176# static methods. not really.
179 177
180=back 178=back
… …
226The pool size is limited to 8 idle coroutines (this can be adjusted by 224The pool size is limited to 8 idle coroutines (this can be adjusted by
227changing $Coro::POOL_SIZE), and there can be as many non-idle coros as 225changing $Coro::POOL_SIZE), and there can be as many non-idle coros as
228required. 226required.
229 227
230If you are concerned about pooled coroutines growing a lot because a 228If you are concerned about pooled coroutines growing a lot because a
231single C<async_pool> used a lot of stackspace you can e.g. C<async_pool { 229single C<async_pool> used a lot of stackspace you can e.g. C<async_pool
232terminate }> once per second or so to slowly replenish the pool. 230{ terminate }> once per second or so to slowly replenish the pool. In
231addition to that, when the stacks used by a handler grows larger than 16kb
232(adjustable with $Coro::POOL_RSS) it will also exit.
233 233
234=cut 234=cut
235 235
236our $POOL_SIZE = 8; 236our $POOL_SIZE = 8;
237our $MAX_POOL_RSS = 64 * 1024; 237our $POOL_RSS = 16 * 1024;
238our @pool; 238our @async_pool;
239 239
240sub pool_handler { 240sub pool_handler {
241 my $cb;
242
241 while () { 243 while () {
242 $current->{desc} = "[async_pool]";
243
244 eval { 244 eval {
245 my ($cb, @arg) = @{ delete $current->{_invoke} or return }; 245 while () {
246 $cb->(@arg); 246 _pool_1 $cb;
247 &$cb;
248 _pool_2 $cb;
249 &schedule;
250 }
247 }; 251 };
252
253 last if $@ eq "\3terminate\2\n";
248 warn $@ if $@; 254 warn $@ if $@;
249
250 last if @pool >= $POOL_SIZE || $current->rss >= $MAX_POOL_RSS;
251
252 push @pool, $current;
253 $current->{desc} = "[async_pool idle]";
254 $current->save (Coro::State::SAVE_DEF);
255 $current->prio (0);
256 schedule;
257 } 255 }
258} 256}
259 257
260sub async_pool(&@) { 258sub async_pool(&@) {
261 # this is also inlined into the unlock_scheduler 259 # this is also inlined into the unlock_scheduler
262 my $coro = (pop @pool) || new Coro \&pool_handler;; 260 my $coro = (pop @async_pool) || new Coro \&pool_handler;
263 261
264 $coro->{_invoke} = [@_]; 262 $coro->{_invoke} = [@_];
265 $coro->ready; 263 $coro->ready;
266 264
267 $coro 265 $coro
… …
310 308
311=item terminate [arg...] 309=item terminate [arg...]
312 310
313Terminates the current coroutine with the given status values (see L<cancel>). 311Terminates the current coroutine with the given status values (see L<cancel>).
314 312
313=item killall
314
315Kills/terminates/cancels all coroutines except the currently running
316one. This is useful after a fork, either in the child or the parent, as
317usually only one of them should inherit the running coroutines.
318
315=cut 319=cut
316 320
317sub terminate { 321sub terminate {
318 $current->cancel (@_); 322 $current->cancel (@_);
323}
324
325sub killall {
326 for (Coro::State::list) {
327 $_->cancel
328 if $_ != $current && UNIVERSAL::isa $_, "Coro";
329 }
319} 330}
320 331
321=back 332=back
322 333
323# dynamic methods 334# dynamic methods
… …
367 378
368=cut 379=cut
369 380
370sub cancel { 381sub cancel {
371 my $self = shift; 382 my $self = shift;
372 $self->{status} = [@_]; 383 $self->{_status} = [@_];
373 384
374 if ($current == $self) { 385 if ($current == $self) {
375 push @destroy, $self; 386 push @destroy, $self;
376 $manager->ready; 387 $manager->ready;
377 &schedule while 1; 388 &schedule while 1;
… …
389=cut 400=cut
390 401
391sub join { 402sub join {
392 my $self = shift; 403 my $self = shift;
393 404
394 unless ($self->{status}) { 405 unless ($self->{_status}) {
395 my $current = $current; 406 my $current = $current;
396 407
397 push @{$self->{destroy_cb}}, sub { 408 push @{$self->{_on_destroy}}, sub {
398 $current->ready; 409 $current->ready;
399 undef $current; 410 undef $current;
400 }; 411 };
401 412
402 &schedule while $current; 413 &schedule while $current;
403 } 414 }
404 415
405 wantarray ? @{$self->{status}} : $self->{status}[0]; 416 wantarray ? @{$self->{_status}} : $self->{_status}[0];
406} 417}
407 418
408=item $coroutine->on_destroy (\&cb) 419=item $coroutine->on_destroy (\&cb)
409 420
410Registers a callback that is called when this coroutine gets destroyed, 421Registers a callback that is called when this coroutine gets destroyed,
… …
414=cut 425=cut
415 426
416sub on_destroy { 427sub on_destroy {
417 my ($self, $cb) = @_; 428 my ($self, $cb) = @_;
418 429
419 push @{ $self->{destroy_cb} }, $cb; 430 push @{ $self->{_on_destroy} }, $cb;
420} 431}
421 432
422=item $oldprio = $coroutine->prio ($newprio) 433=item $oldprio = $coroutine->prio ($newprio)
423 434
424Sets (or gets, if the argument is missing) the priority of the 435Sets (or gets, if the argument is missing) the priority of the
… …
448 459
449=item $olddesc = $coroutine->desc ($newdesc) 460=item $olddesc = $coroutine->desc ($newdesc)
450 461
451Sets (or gets in case the argument is missing) the description for this 462Sets (or gets in case the argument is missing) the description for this
452coroutine. This is just a free-form string you can associate with a coroutine. 463coroutine. This is just a free-form string you can associate with a coroutine.
464
465This method simply sets the C<< $coroutine->{desc} >> member to the given string. You
466can modify this member directly if you wish.
453 467
454=cut 468=cut
455 469
456sub desc { 470sub desc {
457 my $old = $_[0]{desc}; 471 my $old = $_[0]{desc};
… …
533 547
534# we create a special coro because we want to cede, 548# we create a special coro because we want to cede,
535# to reduce pressure on the coro pool (because most callbacks 549# to reduce pressure on the coro pool (because most callbacks
536# return immediately and can be reused) and because we cannot cede 550# return immediately and can be reused) and because we cannot cede
537# inside an event callback. 551# inside an event callback.
538our $unblock_scheduler = async { 552our $unblock_scheduler = new Coro sub {
539 $current->desc ("[unblock_sub scheduler]");
540 while () { 553 while () {
541 while (my $cb = pop @unblock_queue) { 554 while (my $cb = pop @unblock_queue) {
542 # this is an inlined copy of async_pool 555 # this is an inlined copy of async_pool
543 my $coro = (pop @pool or new Coro \&pool_handler); 556 my $coro = (pop @async_pool) || new Coro \&pool_handler;
544 557
545 $coro->{_invoke} = $cb; 558 $coro->{_invoke} = $cb;
546 $coro->ready; 559 $coro->ready;
547 cede; # for short-lived callbacks, this reduces pressure on the coro pool 560 cede; # for short-lived callbacks, this reduces pressure on the coro pool
548 } 561 }
549 schedule; # sleep well 562 schedule; # sleep well
550 } 563 }
551}; 564};
565$unblock_scheduler->desc ("[unblock_sub scheduler]");
552 566
553sub unblock_sub(&) { 567sub unblock_sub(&) {
554 my $cb = shift; 568 my $cb = shift;
555 569
556 sub { 570 sub {

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines