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

Comparing Coro/Coro.pm (file contents):
Revision 1.92 by root, Fri Dec 1 03:47:55 2006 UTC vs.
Revision 1.102 by root, Fri Dec 29 11:37:49 2006 UTC

… …
18 18
19 cede; 19 cede;
20 20
21=head1 DESCRIPTION 21=head1 DESCRIPTION
22 22
23This module collection manages coroutines. Coroutines are similar to 23This module collection manages coroutines. Coroutines are similar
24threads but don't run in parallel. 24to threads but don't run in parallel at the same time even on SMP
25machines. The specific flavor of coroutine use din this module also
26guarentees you that it will not switch between coroutines unless
27necessary, at easily-identified points in your program, so locking and
28parallel access are rarely an issue, making coroutine programming much
29safer than threads programming.
25 30
31(Perl, however, does not natively support real threads but instead does a
32very slow and memory-intensive emulation of processes using threads. This
33is a performance win on Windows machines, and a loss everywhere else).
34
26In this module, coroutines are defined as "callchain + lexical variables 35In this module, coroutines are defined as "callchain + lexical variables +
27+ @_ + $_ + $@ + $^W + C stack), that is, a coroutine has it's own 36@_ + $_ + $@ + $/ + C stack), that is, a coroutine has its own callchain,
28callchain, it's own set of lexicals and it's own set of perl's most 37its own set of lexicals and its own set of perls most important global
29important global variables. 38variables.
30 39
31=cut 40=cut
32 41
33package Coro; 42package Coro;
34 43
… …
41 50
42our $idle; # idle handler 51our $idle; # idle handler
43our $main; # main coroutine 52our $main; # main coroutine
44our $current; # current coroutine 53our $current; # current coroutine
45 54
46our $VERSION = '3.0'; 55our $VERSION = '3.3';
47 56
48our @EXPORT = qw(async cede schedule terminate current unblock_sub); 57our @EXPORT = qw(async cede schedule terminate current unblock_sub);
49our %EXPORT_TAGS = ( 58our %EXPORT_TAGS = (
50 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)],
51); 60);
52our @EXPORT_OK = @{$EXPORT_TAGS{prio}}; 61our @EXPORT_OK = (@{$EXPORT_TAGS{prio}}, qw(nready));
53 62
54{ 63{
55 my @async; 64 my @async;
56 my $init; 65 my $init;
57 66
58 # this way of handling attributes simply is NOT scalable ;() 67 # this way of handling attributes simply is NOT scalable ;()
59 sub import { 68 sub import {
60 no strict 'refs'; 69 no strict 'refs';
61 70
62 Coro->export_to_level(1, @_); 71 Coro->export_to_level (1, @_);
63 72
64 my $old = *{(caller)[0]."::MODIFY_CODE_ATTRIBUTES"}{CODE}; 73 my $old = *{(caller)[0]."::MODIFY_CODE_ATTRIBUTES"}{CODE};
65 *{(caller)[0]."::MODIFY_CODE_ATTRIBUTES"} = sub { 74 *{(caller)[0]."::MODIFY_CODE_ATTRIBUTES"} = sub {
66 my ($package, $ref) = (shift, shift); 75 my ($package, $ref) = (shift, shift);
67 my @attrs; 76 my @attrs;
… …
105C<Coro::current> function instead. 114C<Coro::current> function instead.
106 115
107=cut 116=cut
108 117
109# maybe some other module used Coro::Specific before... 118# maybe some other module used Coro::Specific before...
110if ($current) {
111 $main->{specific} = $current->{specific}; 119$main->{specific} = $current->{specific}
112} 120 if $current;
113 121
114$current = $main; 122_set_current $main;
115 123
116sub current() { $current } 124sub current() { $current }
117 125
118=item $idle 126=item $idle
119 127
… …
129handlers), then it must be prepared to be called recursively. 137handlers), then it must be prepared to be called recursively.
130 138
131=cut 139=cut
132 140
133$idle = sub { 141$idle = sub {
134 print STDERR "FATAL: deadlock detected\n"; 142 require Carp;
135 exit (51); 143 Carp::croak ("FATAL: deadlock detected");
136}; 144};
137 145
138# this coroutine is necessary because a coroutine 146# this coroutine is necessary because a coroutine
139# cannot destroy itself. 147# cannot destroy itself.
140my @destroy; 148my @destroy;
… …
145 # been readied multiple times. this is harmless since the manager 153 # been readied multiple times. this is harmless since the manager
146 # can be called as many times as neccessary and will always 154 # can be called as many times as neccessary and will always
147 # remove itself from the runqueue 155 # remove itself from the runqueue
148 while (@destroy) { 156 while (@destroy) {
149 my $coro = pop @destroy; 157 my $coro = pop @destroy;
158
150 $coro->{status} ||= []; 159 $coro->{status} ||= [];
160
151 $_->ready for @{delete $coro->{join} || []}; 161 $_->ready for @{(delete $coro->{join} ) || []};
162 $_->(@{$coro->{status}}) for @{(delete $coro->{destroy_cb}) || []};
152 163
153 # the next line destroys the coro state, but keeps the 164 # the next line destroys the coro state, but keeps the
154 # coroutine itself intact (we basically make it a zombie 165 # coroutine itself intact (we basically make it a zombie
155 # coroutine that always runs the manager thread, so it's possible 166 # coroutine that always runs the manager thread, so it's possible
156 # to transfer() to this coroutine). 167 # to transfer() to this coroutine).
… …
224 235
225"Cede" to other coroutines. This function puts the current coroutine into the 236"Cede" to other coroutines. This function puts the current coroutine into the
226ready queue and calls C<schedule>, which has the effect of giving up the 237ready queue and calls C<schedule>, which has the effect of giving up the
227current "timeslice" to other coroutines of the same or higher priority. 238current "timeslice" to other coroutines of the same or higher priority.
228 239
240=item Coro::cede_notself
241
242Works like cede, but is not exported by default and will cede to any
243coroutine, regardless of priority, once.
244
229=item terminate [arg...] 245=item terminate [arg...]
230 246
231Terminates the current coroutine with the given status values (see L<cancel>). 247Terminates the current coroutine with the given status values (see L<cancel>).
232 248
233=cut 249=cut
… …
255 271
256Calling C<exit> in a coroutine will not work correctly, so do not do that. 272Calling C<exit> in a coroutine will not work correctly, so do not do that.
257 273
258=cut 274=cut
259 275
260sub _new_coro { 276sub _run_coro {
261 terminate &{+shift}; 277 terminate &{+shift};
262} 278}
263 279
264sub new { 280sub new {
265 my $class = shift; 281 my $class = shift;
266 282
267 $class->SUPER::new (\&_new_coro, @_) 283 $class->SUPER::new (\&_run_coro, @_)
268} 284}
269 285
270=item $success = $coroutine->ready 286=item $success = $coroutine->ready
271 287
272Put the given coroutine into the ready queue (according to it's priority) 288Put the given coroutine into the ready queue (according to it's priority)
… …
307 &schedule; 323 &schedule;
308 } 324 }
309 wantarray ? @{$self->{status}} : $self->{status}[0]; 325 wantarray ? @{$self->{status}} : $self->{status}[0];
310} 326}
311 327
328=item $coroutine->on_destroy (\&cb)
329
330Registers a callback that is called when this coroutine gets destroyed,
331but before it is joined. The callback gets passed the terminate arguments,
332if any.
333
334=cut
335
336sub on_destroy {
337 my ($self, $cb) = @_;
338
339 push @{ $self->{destroy_cb} }, $cb;
340}
341
312=item $oldprio = $coroutine->prio ($newprio) 342=item $oldprio = $coroutine->prio ($newprio)
313 343
314Sets (or gets, if the argument is missing) the priority of the 344Sets (or gets, if the argument is missing) the priority of the
315coroutine. Higher priority coroutines get run before lower priority 345coroutine. Higher priority coroutines get run before lower priority
316coroutines. Priorities are small signed integers (currently -4 .. +3), 346coroutines. Priorities are small signed integers (currently -4 .. +3),
… …
349 $old; 379 $old;
350} 380}
351 381
352=back 382=back
353 383
354=head2 UTILITY FUNCTIONS 384=head2 GLOBAL FUNCTIONS
355 385
356=over 4 386=over 4
387
388=item Coro::nready
389
390Returns the number of coroutines that are currently in the ready state,
391i.e. that can be swicthed to. The value C<0> means that the only runnable
392coroutine is the currently running one, so C<cede> would have no effect,
393and C<schedule> would cause a deadlock unless there is an idle handler
394that wakes up some coroutines.
357 395
358=item unblock_sub { ... } 396=item unblock_sub { ... }
359 397
360This utility function takes a BLOCK or code reference and "unblocks" it, 398This utility function takes a BLOCK or code reference and "unblocks" it,
361returning the new coderef. This means that the new coderef will return 399returning the new coderef. This means that the new coderef will return

Diff Legend

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