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

Comparing cvsroot/Coro/Coro.pm (file contents):
Revision 1.93 by root, Fri Dec 1 19:41:06 2006 UTC vs.
Revision 1.101 by root, Fri Dec 29 08:36:34 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
… …
128handlers), then it must be prepared to be called recursively. 137handlers), then it must be prepared to be called recursively.
129 138
130=cut 139=cut
131 140
132$idle = sub { 141$idle = sub {
133 print STDERR "FATAL: deadlock detected\n"; 142 require Carp;
134 exit (51); 143 Carp::croak ("FATAL: deadlock detected");
135}; 144};
136 145
137# this coroutine is necessary because a coroutine 146# this coroutine is necessary because a coroutine
138# cannot destroy itself. 147# cannot destroy itself.
139my @destroy; 148my @destroy;
… …
144 # been readied multiple times. this is harmless since the manager 153 # been readied multiple times. this is harmless since the manager
145 # can be called as many times as neccessary and will always 154 # can be called as many times as neccessary and will always
146 # remove itself from the runqueue 155 # remove itself from the runqueue
147 while (@destroy) { 156 while (@destroy) {
148 my $coro = pop @destroy; 157 my $coro = pop @destroy;
158
149 $coro->{status} ||= []; 159 $coro->{status} ||= [];
160
150 $_->ready for @{delete $coro->{join} || []}; 161 $_->ready for @{(delete $coro->{join} ) || []};
162 $_->(@{$coro->{status}}) for @{(delete $coro->{destroy_cb}) || []};
151 163
152 # the next line destroys the coro state, but keeps the 164 # the next line destroys the coro state, but keeps the
153 # coroutine itself intact (we basically make it a zombie 165 # coroutine itself intact (we basically make it a zombie
154 # coroutine that always runs the manager thread, so it's possible 166 # coroutine that always runs the manager thread, so it's possible
155 # to transfer() to this coroutine). 167 # to transfer() to this coroutine).
… …
254 266
255Calling C<exit> in a coroutine will not work correctly, so do not do that. 267Calling C<exit> in a coroutine will not work correctly, so do not do that.
256 268
257=cut 269=cut
258 270
259sub _new_coro { 271sub _run_coro {
260 terminate &{+shift}; 272 terminate &{+shift};
261} 273}
262 274
263sub new { 275sub new {
264 my $class = shift; 276 my $class = shift;
265 277
266 $class->SUPER::new (\&_new_coro, @_) 278 $class->SUPER::new (\&_run_coro, @_)
267} 279}
268 280
269=item $success = $coroutine->ready 281=item $success = $coroutine->ready
270 282
271Put the given coroutine into the ready queue (according to it's priority) 283Put the given coroutine into the ready queue (according to it's priority)
… …
306 &schedule; 318 &schedule;
307 } 319 }
308 wantarray ? @{$self->{status}} : $self->{status}[0]; 320 wantarray ? @{$self->{status}} : $self->{status}[0];
309} 321}
310 322
323=item $coroutine->on_destroy (\&cb)
324
325Registers a callback that is called when this coroutine gets destroyed,
326but before it is joined. The callback gets passed the terminate arguments,
327if any.
328
329=cut
330
331sub on_destroy {
332 my ($self, $cb) = @_;
333
334 push @{ $self->{destroy_cb} }, $cb;
335}
336
311=item $oldprio = $coroutine->prio ($newprio) 337=item $oldprio = $coroutine->prio ($newprio)
312 338
313Sets (or gets, if the argument is missing) the priority of the 339Sets (or gets, if the argument is missing) the priority of the
314coroutine. Higher priority coroutines get run before lower priority 340coroutine. Higher priority coroutines get run before lower priority
315coroutines. Priorities are small signed integers (currently -4 .. +3), 341coroutines. Priorities are small signed integers (currently -4 .. +3),
… …
348 $old; 374 $old;
349} 375}
350 376
351=back 377=back
352 378
353=head2 UTILITY FUNCTIONS 379=head2 GLOBAL FUNCTIONS
354 380
355=over 4 381=over 4
382
383=item Coro::nready
384
385Returns the number of coroutines that are currently in the ready state,
386i.e. that can be swicthed to. The value C<0> means that the only runnable
387coroutine is the currently running one, so C<cede> would have no effect,
388and C<schedule> would cause a deadlock unless there is an idle handler
389that wakes up some coroutines.
356 390
357=item unblock_sub { ... } 391=item unblock_sub { ... }
358 392
359This utility function takes a BLOCK or code reference and "unblocks" it, 393This utility function takes a BLOCK or code reference and "unblocks" it,
360returning the new coderef. This means that the new coderef will return 394returning the new coderef. This means that the new coderef will return

Diff Legend

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