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

Comparing Coro/Coro.pm (file contents):
Revision 1.53 by root, Tue May 27 01:15:26 2003 UTC vs.
Revision 1.66 by root, Thu Mar 3 17:20:31 2005 UTC

… …
30 30
31=cut 31=cut
32 32
33package Coro; 33package Coro;
34 34
35no warnings qw(uninitialized); 35BEGIN { eval { require warnings } && warnings->unimport ("uninitialized") }
36 36
37use Coro::State; 37use Coro::State;
38 38
39use vars qw($idle $main $current);
40
39use base Exporter; 41use base Exporter;
40 42
41$VERSION = 0.7; 43$VERSION = 1.11;
42 44
43@EXPORT = qw(async cede schedule terminate current); 45@EXPORT = qw(async cede schedule terminate current);
44%EXPORT_TAGS = ( 46%EXPORT_TAGS = (
45 prio => [qw(PRIO_MAX PRIO_HIGH PRIO_NORMAL PRIO_LOW PRIO_IDLE PRIO_MIN)], 47 prio => [qw(PRIO_MAX PRIO_HIGH PRIO_NORMAL PRIO_LOW PRIO_IDLE PRIO_MIN)],
46); 48);
… …
83 85
84This coroutine represents the main program. 86This coroutine represents the main program.
85 87
86=cut 88=cut
87 89
88our $main = new Coro; 90$main = new Coro;
89 91
90=item $current (or as function: current) 92=item $current (or as function: current)
91 93
92The current coroutine (the last coroutine switched to). The initial value is C<$main> (of course). 94The current coroutine (the last coroutine switched to). The initial value is C<$main> (of course).
93 95
… …
96# maybe some other module used Coro::Specific before... 98# maybe some other module used Coro::Specific before...
97if ($current) { 99if ($current) {
98 $main->{specific} = $current->{specific}; 100 $main->{specific} = $current->{specific};
99} 101}
100 102
101our $current = $main; 103$current = $main;
102 104
103sub current() { $current } 105sub current() { $current }
104 106
105=item $idle 107=item $idle
106 108
… …
108implementation prints "FATAL: deadlock detected" and exits. 110implementation prints "FATAL: deadlock detected" and exits.
109 111
110=cut 112=cut
111 113
112# should be done using priorities :( 114# should be done using priorities :(
113our $idle = new Coro sub { 115$idle = new Coro sub {
114 print STDERR "FATAL: deadlock detected\n"; 116 print STDERR "FATAL: deadlock detected\n";
115 exit(51); 117 exit(51);
116}; 118};
117 119
118# this coroutine is necessary because a coroutine 120# this coroutine is necessary because a coroutine
119# cannot destroy itself. 121# cannot destroy itself.
120my @destroy; 122my @destroy;
121my $manager; 123my $manager;
122$manager = new Coro sub { 124$manager = new Coro sub {
123 while() { 125 while () {
124 # by overwriting the state object with the manager we destroy it 126 # by overwriting the state object with the manager we destroy it
125 # while still being able to schedule this coroutine (in case it has 127 # while still being able to schedule this coroutine (in case it has
126 # been readied multiple times. this is harmless since the manager 128 # been readied multiple times. this is harmless since the manager
127 # can be called as many times as neccessary and will always 129 # can be called as many times as neccessary and will always
128 # remove itself from the runqueue 130 # remove itself from the runqueue
129 while (@destroy) { 131 while (@destroy) {
130 my $coro = pop @destroy; 132 my $coro = pop @destroy;
131 $coro->{status} ||= []; 133 $coro->{status} ||= [];
132 $_->ready for @{delete $coro->{join} || []}; 134 $_->ready for @{delete $coro->{join} || []};
135
136 # the next line destroys the _coro_state, but keeps the
137 # process itself intact (we basically make it a zombie
138 # process that always runs the manager thread, so it's possible
139 # to transfer() to this process).
133 $coro->{_coro_state} = $manager->{_coro_state}; 140 $coro->{_coro_state} = $manager->{_coro_state};
134 } 141 }
135 &schedule; 142 &schedule;
136 } 143 }
137}; 144};
… …
155 # create a new coroutine that just prints its arguments 162 # create a new coroutine that just prints its arguments
156 async { 163 async {
157 print "@_\n"; 164 print "@_\n";
158 } 1,2,3,4; 165 } 1,2,3,4;
159 166
160The coderef you submit MUST NOT be a closure that refers to variables
161in an outer scope. This does NOT work. Pass arguments into it instead.
162
163=cut 167=cut
164 168
165sub async(&@) { 169sub async(&@) {
166 my $pid = new Coro @_; 170 my $pid = new Coro @_;
167 $manager->ready; # this ensures that the stack is cloned from the manager 171 $manager->ready; # this ensures that the stack is cloned from the manager
… …
185 189
186=cut 190=cut
187 191
188=item terminate [arg...] 192=item terminate [arg...]
189 193
190Terminates the current process. 194Terminates the current process with the given status values (see L<cancel>).
191
192Future versions of this function will allow result arguments.
193 195
194=cut 196=cut
195 197
196sub terminate { 198sub terminate {
197 $current->{status} = [@_];
198 $current->cancel; 199 $current->cancel (@_);
199 &schedule;
200 die; # NORETURN
201} 200}
202 201
203=back 202=back
204 203
205# dynamic methods 204# dynamic methods
… …
234 233
235Put the given process into the ready queue. 234Put the given process into the ready queue.
236 235
237=cut 236=cut
238 237
239=item $process->cancel 238=item $process->cancel (arg...)
240 239
241Like C<terminate>, but terminates the specified process instead. 240Temrinates the given process and makes it return the given arguments as
241status (default: the empty list).
242 242
243=cut 243=cut
244 244
245sub cancel { 245sub cancel {
246 my $self = shift;
247 $self->{status} = [@_];
246 push @destroy, $_[0]; 248 push @destroy, $self;
247 $manager->ready; 249 $manager->ready;
248 &schedule if $current == $_[0]; 250 &schedule if $current == $self;
249} 251}
250 252
251=item $process->join 253=item $process->join
252 254
253Wait until the coroutine terminates and return any values given to the 255Wait until the coroutine terminates and return any values given to the
254C<terminate> function. C<join> can be called multiple times from multiple 256C<terminate> or C<cancel> functions. C<join> can be called multiple times
255processes. 257from multiple processes.
256 258
257=cut 259=cut
258 260
259sub join { 261sub join {
260 my $self = shift; 262 my $self = shift;
… …
336 this). 338 this).
337 339
338=head1 SEE ALSO 340=head1 SEE ALSO
339 341
340L<Coro::Channel>, L<Coro::Cont>, L<Coro::Specific>, L<Coro::Semaphore>, 342L<Coro::Channel>, L<Coro::Cont>, L<Coro::Specific>, L<Coro::Semaphore>,
341L<Coro::Signal>, L<Coro::State>, L<Coro::Event>, L<Coro::RWLock>, 343L<Coro::Signal>, L<Coro::State>, L<Coro::Timer>, L<Coro::Event>,
342L<Coro::Handle>, L<Coro::Socket>. 344L<Coro::Handle>, L<Coro::RWLock>, L<Coro::Socket>.
343 345
344=head1 AUTHOR 346=head1 AUTHOR
345 347
346 Marc Lehmann <pcg@goof.com> 348 Marc Lehmann <schmorp@schmorp.de>
347 http://www.goof.com/pcg/marc/ 349 http://home.schmorp.de/
348 350
349=cut 351=cut
350 352

Diff Legend

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