[ViewVC] Diff of: cvs/Coro/Coro.pm

Comparing Coro/Coro.pm (file contents):
Revision 1.94 by root, Sat Dec 2 18:01:30 2006 UTC vs.
Revision 1.103 by root, Thu Jan 4 20:14:19 2007 UTC

…		…
18		18
19	cede;	19	cede;
20		20
21	=head1 DESCRIPTION	21	=head1 DESCRIPTION
22		22
23	This module collection manages coroutines. Coroutines are similar to	23	This module collection manages coroutines. Coroutines are similar
24	threads but don't run in parallel.	24	to threads but don't run in parallel at the same time even on SMP
		25	machines. The specific flavor of coroutine use din this module also
		26	guarentees you that it will not switch between coroutines unless
		27	necessary, at easily-identified points in your program, so locking and
		28	parallel access are rarely an issue, making coroutine programming much
		29	safer than threads programming.
25		30
		31	(Perl, however, does not natively support real threads but instead does a
		32	very slow and memory-intensive emulation of processes using threads. This
		33	is a performance win on Windows machines, and a loss everywhere else).
		34
26	In this module, coroutines are defined as "callchain + lexical variables	35	In 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,
28	callchain, it's own set of lexicals and it's own set of perl's most	37	its own set of lexicals and its own set of perls most important global
29	important global variables.	38	variables.
30		39
31	=cut	40	=cut
32		41
33	package Coro;	42	package Coro;
34		43
…		…
41		50
42	our $idle; # idle handler	51	our $idle; # idle handler
43	our $main; # main coroutine	52	our $main; # main coroutine
44	our $current; # current coroutine	53	our $current; # current coroutine
45		54
46	our $VERSION = '3.0';	55	our $VERSION = '3.3';
47		56
48	our @EXPORT = qw(async cede schedule terminate current unblock_sub);	57	our @EXPORT = qw(async cede schedule terminate current unblock_sub);
49	our %EXPORT_TAGS = (	58	our %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	);
52	our @EXPORT_OK = @{$EXPORT_TAGS{prio}};	61	our @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
…		…
128	handlers), then it must be prepared to be called recursively.	137	handlers), 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	};
		145
		146	sub _cancel {
		147	my ($self) = @_;
		148
		149	# free coroutine data and mark as destructed
		150	$self->_destroy
		151	or return;
		152
		153	# call all destruction callbacks
		154	$_->(@{$self->{status}})
		155	for @{(delete $self->{destroy_cb}) \|\| []};
		156	}
136		157
137	# this coroutine is necessary because a coroutine	158	# this coroutine is necessary because a coroutine
138	# cannot destroy itself.	159	# cannot destroy itself.
139	my @destroy;	160	my @destroy;
		161	my $manager;
		162
140	my $manager; $manager = new Coro sub {	163	$manager = new Coro sub {
141	while () {	164	while () {
142	# by overwriting the state object with the manager we destroy it	165	(shift @destroy)->_cancel
143	# while still being able to schedule this coroutine (in case it has
144	# been readied multiple times. this is harmless since the manager
145	# can be called as many times as neccessary and will always
146	# remove itself from the runqueue
147	while (@destroy) {	166	while @destroy;
148	my $coro = pop @destroy;
149	$coro->{status} \|\|= [];
150	$_->ready for @{delete $coro->{join} \|\| []};
151		167
152	# the next line destroys the coro state, but keeps the
153	# coroutine itself intact (we basically make it a zombie
154	# coroutine that always runs the manager thread, so it's possible
155	# to transfer() to this coroutine).
156	$coro->_clone_state_from ($manager);
157	}
158	&schedule;	168	&schedule;
159	}	169	}
160	};	170	};
		171
		172	$manager->prio (PRIO_MAX);
161		173
162	# static methods. not really.	174	# static methods. not really.
163		175
164	=back	176	=back
165		177
…		…
223		235
224	"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
225	ready queue and calls C<schedule>, which has the effect of giving up the	237	ready queue and calls C<schedule>, which has the effect of giving up the
226	current "timeslice" to other coroutines of the same or higher priority.	238	current "timeslice" to other coroutines of the same or higher priority.
227		239
		240	=item Coro::cede_notself
		241
		242	Works like cede, but is not exported by default and will cede to any
		243	coroutine, regardless of priority, once.
		244
228	=item terminate [arg...]	245	=item terminate [arg...]
229		246
230	Terminates the current coroutine with the given status values (see L<cancel>).	247	Terminates the current coroutine with the given status values (see L<cancel>).
231		248
232	=cut	249	=cut
…		…
277	Return wether the coroutine is currently the ready queue or not,	294	Return wether the coroutine is currently the ready queue or not,
278		295
279	=item $coroutine->cancel (arg...)	296	=item $coroutine->cancel (arg...)
280		297
281	Terminates the given coroutine and makes it return the given arguments as	298	Terminates the given coroutine and makes it return the given arguments as
282	status (default: the empty list).	299	status (default: the empty list). Never returns if the coroutine is the
		300	current coroutine.
283		301
284	=cut	302	=cut
285		303
286	sub cancel {	304	sub cancel {
287	my $self = shift;	305	my $self = shift;
288	$self->{status} = [@_];	306	$self->{status} = [@_];
		307
		308	if ($current == $self) {
289	push @destroy, $self;	309	push @destroy, $self;
290	$manager->ready;	310	$manager->ready;
291	&schedule if $current == $self;	311	&schedule while 1;
		312	} else {
		313	$self->_cancel;
		314	}
292	}	315	}
293		316
294	=item $coroutine->join	317	=item $coroutine->join
295		318
296	Wait until the coroutine terminates and return any values given to the	319	Wait until the coroutine terminates and return any values given to the
…		…
299		322
300	=cut	323	=cut
301		324
302	sub join {	325	sub join {
303	my $self = shift;	326	my $self = shift;
		327
304	unless ($self->{status}) {	328	unless ($self->{status}) {
305	push @{$self->{join}}, $current;	329	my $current = $current;
306	&schedule;	330
		331	push @{$self->{destroy_cb}}, sub {
		332	$current->ready;
		333	undef $current;
		334	};
		335
		336	&schedule while $current;
307	}	337	}
		338
308	wantarray ? @{$self->{status}} : $self->{status}[0];	339	wantarray ? @{$self->{status}} : $self->{status}[0];
		340	}
		341
		342	=item $coroutine->on_destroy (\&cb)
		343
		344	Registers a callback that is called when this coroutine gets destroyed,
		345	but before it is joined. The callback gets passed the terminate arguments,
		346	if any.
		347
		348	=cut
		349
		350	sub on_destroy {
		351	my ($self, $cb) = @_;
		352
		353	push @{ $self->{destroy_cb} }, $cb;
309	}	354	}
310		355
311	=item $oldprio = $coroutine->prio ($newprio)	356	=item $oldprio = $coroutine->prio ($newprio)
312		357
313	Sets (or gets, if the argument is missing) the priority of the	358	Sets (or gets, if the argument is missing) the priority of the
…		…
348	$old;	393	$old;
349	}	394	}
350		395
351	=back	396	=back
352		397
353	=head2 UTILITY FUNCTIONS	398	=head2 GLOBAL FUNCTIONS
354		399
355	=over 4	400	=over 4
		401
		402	=item Coro::nready
		403
		404	Returns the number of coroutines that are currently in the ready state,
		405	i.e. that can be swicthed to. The value C<0> means that the only runnable
		406	coroutine is the currently running one, so C<cede> would have no effect,
		407	and C<schedule> would cause a deadlock unless there is an idle handler
		408	that wakes up some coroutines.
		409
		410	=item my $guard = Coro::guard { ... }
		411
		412	This creates and returns a guard object. Nothing happens until the objetc
		413	gets destroyed, in which case the codeblock given as argument will be
		414	executed. This is useful to free locks or other resources in case of a
		415	runtime error or when the coroutine gets canceled, as in both cases the
		416	guard block will be executed. The guard object supports only one method,
		417	C<< ->cancel >>, which will keep the codeblock from being executed.
		418
		419	Example: set some flag and clear it again when the coroutine gets canceled
		420	or the function returns:
		421
		422	sub do_something {
		423	my $guard = Coro::guard { $busy = 0 };
		424	$busy = 1;
		425
		426	# do something that requires $busy to be true
		427	}
		428
		429	=cut
		430
		431	sub guard(&) {
		432	bless \(my $cb = $_[0]), "Coro::guard"
		433	}
		434
		435	sub Coro::guard::cancel {
		436	${$_[0]} = sub { };
		437	}
		438
		439	sub Coro::guard::DESTROY {
		440	${$_[0]}->();
		441	}
		442
356		443
357	=item unblock_sub { ... }	444	=item unblock_sub { ... }
358		445
359	This utility function takes a BLOCK or code reference and "unblocks" it,	446	This utility function takes a BLOCK or code reference and "unblocks" it,
360	returning the new coderef. This means that the new coderef will return	447	returning the new coderef. This means that the new coderef will return

Diff Legend

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

Comparing Coro/Coro.pm (file contents): Revision 1.94 by root, Sat Dec 2 18:01:30 2006 UTC vs. Revision 1.103 by root, Thu Jan 4 20:14:19 2007 UTC

Diff Legend

Comparing Coro/Coro.pm (file contents):
Revision 1.94 by root, Sat Dec 2 18:01:30 2006 UTC vs.
Revision 1.103 by root, Thu Jan 4 20:14:19 2007 UTC