… | |
… | |
67 | |
67 | |
68 | our $idle; # idle handler |
68 | our $idle; # idle handler |
69 | our $main; # main coroutine |
69 | our $main; # main coroutine |
70 | our $current; # current coroutine |
70 | our $current; # current coroutine |
71 | |
71 | |
72 | our $VERSION = 5.0; |
72 | our $VERSION = "5.0"; |
73 | |
73 | |
74 | our @EXPORT = qw(async async_pool cede schedule terminate current unblock_sub); |
74 | our @EXPORT = qw(async async_pool cede schedule terminate current unblock_sub); |
75 | our %EXPORT_TAGS = ( |
75 | our %EXPORT_TAGS = ( |
76 | 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)], |
77 | ); |
77 | ); |
… | |
… | |
135 | $idle = sub { |
135 | $idle = sub { |
136 | require Carp; |
136 | require Carp; |
137 | Carp::croak ("FATAL: deadlock detected"); |
137 | Carp::croak ("FATAL: deadlock detected"); |
138 | }; |
138 | }; |
139 | |
139 | |
140 | sub _cancel { |
|
|
141 | my ($self) = @_; |
|
|
142 | |
|
|
143 | # free coroutine data and mark as destructed |
|
|
144 | $self->_destroy |
|
|
145 | or return; |
|
|
146 | |
|
|
147 | # call all destruction callbacks |
|
|
148 | $_->(@{$self->{_status}}) |
|
|
149 | for @{ delete $self->{_on_destroy} || [] }; |
|
|
150 | } |
|
|
151 | |
|
|
152 | # this coroutine is necessary because a coroutine |
140 | # this coroutine is necessary because a coroutine |
153 | # cannot destroy itself. |
141 | # cannot destroy itself. |
154 | our @destroy; |
142 | our @destroy; |
155 | our $manager; |
143 | our $manager; |
156 | |
144 | |
157 | $manager = new Coro sub { |
145 | $manager = new Coro sub { |
158 | while () { |
146 | while () { |
159 | (shift @destroy)->_cancel |
147 | Coro::_cancel shift @destroy |
160 | while @destroy; |
148 | while @destroy; |
161 | |
149 | |
162 | &schedule; |
150 | &schedule; |
163 | } |
151 | } |
164 | }; |
152 | }; |
… | |
… | |
237 | coros as required. |
225 | coros as required. |
238 | |
226 | |
239 | If you are concerned about pooled coroutines growing a lot because a |
227 | If you are concerned about pooled coroutines growing a lot because a |
240 | single C<async_pool> used a lot of stackspace you can e.g. C<async_pool |
228 | single C<async_pool> used a lot of stackspace you can e.g. C<async_pool |
241 | { terminate }> once per second or so to slowly replenish the pool. In |
229 | { terminate }> once per second or so to slowly replenish the pool. In |
242 | addition to that, when the stacks used by a handler grows larger than 16kb |
230 | addition to that, when the stacks used by a handler grows larger than 32kb |
243 | (adjustable via $Coro::POOL_RSS) it will also be destroyed. |
231 | (adjustable via $Coro::POOL_RSS) it will also be destroyed. |
244 | |
232 | |
245 | =cut |
233 | =cut |
246 | |
234 | |
247 | our $POOL_SIZE = 8; |
235 | our $POOL_SIZE = 8; |
248 | our $POOL_RSS = 16 * 1024; |
236 | our $POOL_RSS = 32 * 1024; |
249 | our @async_pool; |
237 | our @async_pool; |
250 | |
238 | |
251 | sub pool_handler { |
239 | sub pool_handler { |
252 | while () { |
240 | while () { |
253 | eval { |
241 | eval { |
… | |
… | |
319 | you cannot free all of them, so if a coroutine that is not the main |
307 | you cannot free all of them, so if a coroutine that is not the main |
320 | program calls this function, there will be some one-time resource leak. |
308 | program calls this function, there will be some one-time resource leak. |
321 | |
309 | |
322 | =cut |
310 | =cut |
323 | |
311 | |
324 | sub terminate { |
|
|
325 | $current->{_status} = [@_]; |
|
|
326 | push @destroy, $current; |
|
|
327 | $manager->ready; |
|
|
328 | do { &schedule } while 1; |
|
|
329 | } |
|
|
330 | |
|
|
331 | sub killall { |
312 | sub killall { |
332 | for (Coro::State::list) { |
313 | for (Coro::State::list) { |
333 | $_->cancel |
314 | $_->cancel |
334 | if $_ != $current && UNIVERSAL::isa $_, "Coro"; |
315 | if $_ != $current && UNIVERSAL::isa $_, "Coro"; |
335 | } |
316 | } |
… | |
… | |
515 | |
496 | |
516 | sub desc { |
497 | sub desc { |
517 | my $old = $_[0]{desc}; |
498 | my $old = $_[0]{desc}; |
518 | $_[0]{desc} = $_[1] if @_ > 1; |
499 | $_[0]{desc} = $_[1] if @_ > 1; |
519 | $old; |
500 | $old; |
|
|
501 | } |
|
|
502 | |
|
|
503 | sub transfer { |
|
|
504 | require Carp; |
|
|
505 | Carp::croak ("You must not call ->transfer on Coro objects. Use Coro::State objects or the ->schedule_to method. Caught"); |
520 | } |
506 | } |
521 | |
507 | |
522 | =back |
508 | =back |
523 | |
509 | |
524 | =head2 GLOBAL FUNCTIONS |
510 | =head2 GLOBAL FUNCTIONS |