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

Comparing Coro/Coro.pm (file contents):
Revision 1.52 by root, Tue May 27 00:26:34 2003 UTC vs.
Revision 1.65 by root, Tue Feb 22 19:51:58 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.652; 43$VERSION = 1.1;
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;
… …
3261; 3281;
327 329
328=head1 BUGS/LIMITATIONS 330=head1 BUGS/LIMITATIONS
329 331
330 - you must make very sure that no coro is still active on global 332 - you must make very sure that no coro is still active on global
331 destruction. very bad things might happen otherwise (usually segfaults 333 destruction. very bad things might happen otherwise (usually segfaults).
332 or "panic: top_env").
333 334
334 - this module is not thread-safe. You should only ever use this module 335 - this module is not thread-safe. You should only ever use this module
335 from the same thread (this requirement might be losened in the future 336 from the same thread (this requirement might be losened in the future
336 to allow per-thread schedulers, but Coro::State does not yet allow 337 to allow per-thread schedulers, but Coro::State does not yet allow
337 this). 338 this).
338 339
339=head1 SEE ALSO 340=head1 SEE ALSO
340 341
341L<Coro::Channel>, L<Coro::Cont>, L<Coro::Specific>, L<Coro::Semaphore>, 342L<Coro::Channel>, L<Coro::Cont>, L<Coro::Specific>, L<Coro::Semaphore>,
342L<Coro::Signal>, L<Coro::State>, L<Coro::Event>, L<Coro::RWLock>, 343L<Coro::Signal>, L<Coro::State>, L<Coro::Timer>, L<Coro::Event>,
343L<Coro::Handle>, L<Coro::Socket>. 344L<Coro::Handle>, L<Coro::RWLock>, L<Coro::Socket>.
344 345
345=head1 AUTHOR 346=head1 AUTHOR
346 347
347 Marc Lehmann <pcg@goof.com> 348 Marc Lehmann <pcg@goof.com>
348 http://www.goof.com/pcg/marc/ 349 http://home.schmorp.de/
349 350
350=cut 351=cut
351 352

Diff Legend

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