… | |
… | |
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 | }; |
… | |
… | |
318 | Note that while this will try to free some of the main programs resources, |
306 | Note that while this will try to free some of the main programs resources, |
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 | |
|
|
324 | sub terminate { |
|
|
325 | $current->{_status} = [@_]; |
|
|
326 | push @destroy, $current; |
|
|
327 | $manager->ready; |
|
|
328 | do { &schedule } while 1; |
|
|
329 | } |
|
|
330 | |
311 | |
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"; |