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

Comparing Coro/Coro.pm (file contents):
Revision 1.125 by root, Fri Apr 27 19:35:58 2007 UTC vs.
Revision 1.148 by root, Fri Oct 5 20:11:25 2007 UTC

…		…
50		50
51	our $idle; # idle handler	51	our $idle; # idle handler
52	our $main; # main coroutine	52	our $main; # main coroutine
53	our $current; # current coroutine	53	our $current; # current coroutine
54		54
55	our $VERSION = '3.62';	55	our $VERSION = '4.01';
56		56
57	our @EXPORT = qw(async async_pool cede schedule terminate current unblock_sub);	57	our @EXPORT = qw(async async_pool cede schedule terminate current unblock_sub);
58	our %EXPORT_TAGS = (	58	our %EXPORT_TAGS = (
59	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)],
60	);	60	);
…		…
113	reasons. If performance is not essential you are encouraged to use the	113	reasons. If performance is not essential you are encouraged to use the
114	C<Coro::current> function instead.	114	C<Coro::current> function instead.
115		115
116	=cut	116	=cut
117		117
		118	$main->{desc} = "[main::]";
		119
118	# maybe some other module used Coro::Specific before...	120	# maybe some other module used Coro::Specific before...
119	$main->{specific} = $current->{specific}	121	$main->{_specific} = $current->{_specific}
120	if $current;	122	if $current;
121		123
122	_set_current $main;	124	_set_current $main;
123		125
124	sub current() { $current }	126	sub current() { $current }
…		…
149	# free coroutine data and mark as destructed	151	# free coroutine data and mark as destructed
150	$self->_destroy	152	$self->_destroy
151	or return;	153	or return;
152		154
153	# call all destruction callbacks	155	# call all destruction callbacks
154	$_->(@{$self->{status}})	156	$_->(@{$self->{_status}})
155	for @{(delete $self->{destroy_cb}) \|\| []};	157	for @{(delete $self->{_on_destroy}) \|\| []};
156	}	158	}
157		159
158	# this coroutine is necessary because a coroutine	160	# this coroutine is necessary because a coroutine
159	# cannot destroy itself.	161	# cannot destroy itself.
160	my @destroy;	162	my @destroy;
…		…
166	while @destroy;	168	while @destroy;
167		169
168	&schedule;	170	&schedule;
169	}	171	}
170	};	172	};
171		173	$manager->desc ("[coro manager]");
172	$manager->prio (PRIO_MAX);	174	$manager->prio (PRIO_MAX);
173		175
174	# static methods. not really.	176	# static methods. not really.
175		177
176	=back	178	=back
…		…
184	=item async { ... } [@args...]	186	=item async { ... } [@args...]
185		187
186	Create a new asynchronous coroutine and return it's coroutine object	188	Create a new asynchronous coroutine and return it's coroutine object
187	(usually unused). When the sub returns the new coroutine is automatically	189	(usually unused). When the sub returns the new coroutine is automatically
188	terminated.	190	terminated.
		191
		192	See the C<Coro::State::new> constructor for info about the coroutine
		193	environment.
189		194
190	Calling C<exit> in a coroutine will do the same as calling exit outside	195	Calling C<exit> in a coroutine will do the same as calling exit outside
191	the coroutine. Likewise, when the coroutine dies, the program will exit,	196	the coroutine. Likewise, when the coroutine dies, the program will exit,
192	just as it would in the main program.	197	just as it would in the main program.
193		198
…		…
214	issued in case of an exception instead of terminating the program, as	219	issued in case of an exception instead of terminating the program, as
215	C<async> does. As the coroutine is being reused, stuff like C<on_destroy>	220	C<async> does. As the coroutine is being reused, stuff like C<on_destroy>
216	will not work in the expected way, unless you call terminate or cancel,	221	will not work in the expected way, unless you call terminate or cancel,
217	which somehow defeats the purpose of pooling.	222	which somehow defeats the purpose of pooling.
218		223
219	The priority will be reset to C<0> after each job, otherwise the coroutine	224	The priority will be reset to C<0> after each job, tracing will be
220	will be re-used "as-is".	225	disabled, the description will be reset and the default output filehandle
		226	gets restored, so you can change alkl these. Otherwise the coroutine will
		227	be re-used "as-is": most notably if you change other per-coroutine global
		228	stuff such as C<$/> you need to revert that change, which is most simply
		229	done by using local as in C< local $/ >.
221		230
222	The pool size is limited to 8 idle coroutines (this can be adjusted by	231	The pool size is limited to 8 idle coroutines (this can be adjusted by
223	changing $Coro::POOL_SIZE), and there can be as many non-idle coros as	232	changing $Coro::POOL_SIZE), and there can be as many non-idle coros as
224	required.	233	required.
225		234
226	If you are concerned about pooled coroutines growing a lot because a	235	If you are concerned about pooled coroutines growing a lot because a
227	single C<async_pool> used a lot of stackspace you can e.g. C<async_pool {	236	single C<async_pool> used a lot of stackspace you can e.g. C<async_pool
228	terminate }> once per second or so to slowly replenish the pool.	237	{ terminate }> once per second or so to slowly replenish the pool. In
		238	addition to that, when the stacks used by a handler grows larger than 16kb
		239	(adjustable with $Coro::POOL_RSS) it will also exit.
229		240
230	=cut	241	=cut
231		242
232	our $POOL_SIZE = 8;	243	our $POOL_SIZE = 8;
		244	our $POOL_RSS = 16 * 1024;
233	our @pool;	245	our @async_pool;
234		246
235	sub pool_handler {	247	sub pool_handler {
		248	my $cb;
		249
236	while () {	250	while () {
237	eval {	251	eval {
238	my ($cb, @arg) = @{ delete $current->{_invoke} or return };	252	while () {
239	$cb->(@arg);	253	_pool_1 $cb;
		254	&$cb;
		255	_pool_2 $cb;
		256	&schedule;
		257	}
240	};	258	};
		259
		260	last if $@ eq "\3terminate\2\n";
241	warn $@ if $@;	261	warn $@ if $@;
242
243	last if @pool >= $POOL_SIZE;
244	push @pool, $current;
245
246	$current->save (Coro::State::SAVE_DEF);
247	$current->prio (0);
248	schedule;
249	}	262	}
250	}	263	}
251		264
252	sub async_pool(&@) {	265	sub async_pool(&@) {
253	# this is also inlined into the unlock_scheduler	266	# this is also inlined into the unlock_scheduler
254	my $coro = (pop @pool or new Coro \&pool_handler);	267	my $coro = (pop @async_pool) \|\| new Coro \&pool_handler;
255		268
256	$coro->{_invoke} = [@_];	269	$coro->{_invoke} = [@_];
257	$coro->ready;	270	$coro->ready;
258		271
259	$coro	272	$coro
…		…
302		315
303	=item terminate [arg...]	316	=item terminate [arg...]
304		317
305	Terminates the current coroutine with the given status values (see L<cancel>).	318	Terminates the current coroutine with the given status values (see L<cancel>).
306		319
		320	=item killall
		321
		322	Kills/terminates/cancels all coroutines except the currently running
		323	one. This is useful after a fork, either in the child or the parent, as
		324	usually only one of them should inherit the running coroutines.
		325
307	=cut	326	=cut
308		327
309	sub terminate {	328	sub terminate {
310	$current->cancel (@_);	329	$current->cancel (@_);
		330	}
		331
		332	sub killall {
		333	for (Coro::State::list) {
		334	$_->cancel
		335	if $_ != $current && UNIVERSAL::isa $_, "Coro";
		336	}
311	}	337	}
312		338
313	=back	339	=back
314		340
315	# dynamic methods	341	# dynamic methods
…		…
325	Create a new coroutine and return it. When the sub returns the coroutine	351	Create a new coroutine and return it. When the sub returns the coroutine
326	automatically terminates as if C<terminate> with the returned values were	352	automatically terminates as if C<terminate> with the returned values were
327	called. To make the coroutine run you must first put it into the ready queue	353	called. To make the coroutine run you must first put it into the ready queue
328	by calling the ready method.	354	by calling the ready method.
329		355
330	See C<async> for additional discussion.	356	See C<async> and C<Coro::State::new> for additional info about the
		357	coroutine environment.
331		358
332	=cut	359	=cut
333		360
334	sub _run_coro {	361	sub _run_coro {
335	terminate &{+shift};	362	terminate &{+shift};
…		…
359		386
360	=cut	387	=cut
361		388
362	sub cancel {	389	sub cancel {
363	my $self = shift;	390	my $self = shift;
364	$self->{status} = [@_];	391	$self->{_status} = [@_];
365		392
366	if ($current == $self) {	393	if ($current == $self) {
367	push @destroy, $self;	394	push @destroy, $self;
368	$manager->ready;	395	$manager->ready;
369	&schedule while 1;	396	&schedule while 1;
…		…
373	}	400	}
374		401
375	=item $coroutine->join	402	=item $coroutine->join
376		403
377	Wait until the coroutine terminates and return any values given to the	404	Wait until the coroutine terminates and return any values given to the
378	C<terminate> or C<cancel> functions. C<join> can be called multiple times	405	C<terminate> or C<cancel> functions. C<join> can be called concurrently
379	from multiple coroutine.	406	from multiple coroutines.
380		407
381	=cut	408	=cut
382		409
383	sub join {	410	sub join {
384	my $self = shift;	411	my $self = shift;
385		412
386	unless ($self->{status}) {	413	unless ($self->{_status}) {
387	my $current = $current;	414	my $current = $current;
388		415
389	push @{$self->{destroy_cb}}, sub {	416	push @{$self->{_on_destroy}}, sub {
390	$current->ready;	417	$current->ready;
391	undef $current;	418	undef $current;
392	};	419	};
393		420
394	&schedule while $current;	421	&schedule while $current;
395	}	422	}
396		423
397	wantarray ? @{$self->{status}} : $self->{status}[0];	424	wantarray ? @{$self->{_status}} : $self->{_status}[0];
398	}	425	}
399		426
400	=item $coroutine->on_destroy (\&cb)	427	=item $coroutine->on_destroy (\&cb)
401		428
402	Registers a callback that is called when this coroutine gets destroyed,	429	Registers a callback that is called when this coroutine gets destroyed,
…		…
406	=cut	433	=cut
407		434
408	sub on_destroy {	435	sub on_destroy {
409	my ($self, $cb) = @_;	436	my ($self, $cb) = @_;
410		437
411	push @{ $self->{destroy_cb} }, $cb;	438	push @{ $self->{_on_destroy} }, $cb;
412	}	439	}
413		440
414	=item $oldprio = $coroutine->prio ($newprio)	441	=item $oldprio = $coroutine->prio ($newprio)
415		442
416	Sets (or gets, if the argument is missing) the priority of the	443	Sets (or gets, if the argument is missing) the priority of the
…		…
440		467
441	=item $olddesc = $coroutine->desc ($newdesc)	468	=item $olddesc = $coroutine->desc ($newdesc)
442		469
443	Sets (or gets in case the argument is missing) the description for this	470	Sets (or gets in case the argument is missing) the description for this
444	coroutine. This is just a free-form string you can associate with a coroutine.	471	coroutine. This is just a free-form string you can associate with a coroutine.
		472
		473	This method simply sets the C<< $coroutine->{desc} >> member to the given string. You
		474	can modify this member directly if you wish.
445		475
446	=cut	476	=cut
447		477
448	sub desc {	478	sub desc {
449	my $old = $_[0]{desc};	479	my $old = $_[0]{desc};
…		…
525		555
526	# we create a special coro because we want to cede,	556	# we create a special coro because we want to cede,
527	# to reduce pressure on the coro pool (because most callbacks	557	# to reduce pressure on the coro pool (because most callbacks
528	# return immediately and can be reused) and because we cannot cede	558	# return immediately and can be reused) and because we cannot cede
529	# inside an event callback.	559	# inside an event callback.
530	our $unblock_scheduler = async {	560	our $unblock_scheduler = new Coro sub {
531	while () {	561	while () {
532	while (my $cb = pop @unblock_queue) {	562	while (my $cb = pop @unblock_queue) {
533	# this is an inlined copy of async_pool	563	# this is an inlined copy of async_pool
534	my $coro = (pop @pool or new Coro \&pool_handler);	564	my $coro = (pop @async_pool) \|\| new Coro \&pool_handler;
535		565
536	$coro->{_invoke} = $cb;	566	$coro->{_invoke} = $cb;
537	$coro->ready;	567	$coro->ready;
538	cede; # for short-lived callbacks, this reduces pressure on the coro pool	568	cede; # for short-lived callbacks, this reduces pressure on the coro pool
539	}	569	}
540	schedule; # sleep well	570	schedule; # sleep well
541	}	571	}
542	};	572	};
		573	$unblock_scheduler->desc ("[unblock_sub scheduler]");
543		574
544	sub unblock_sub(&) {	575	sub unblock_sub(&) {
545	my $cb = shift;	576	my $cb = shift;
546		577
547	sub {	578	sub {
…		…
566	to allow per-thread schedulers, but Coro::State does not yet allow	597	to allow per-thread schedulers, but Coro::State does not yet allow
567	this).	598	this).
568		599
569	=head1 SEE ALSO	600	=head1 SEE ALSO
570		601
571	Support/Utility: L<Coro::Cont>, L<Coro::Specific>, L<Coro::State>, L<Coro::Util>.	602	Support/Utility: L<Coro::Specific>, L<Coro::State>, L<Coro::Util>.
572		603
573	Locking/IPC: L<Coro::Signal>, L<Coro::Channel>, L<Coro::Semaphore>, L<Coro::SemaphoreSet>, L<Coro::RWLock>.	604	Locking/IPC: L<Coro::Signal>, L<Coro::Channel>, L<Coro::Semaphore>, L<Coro::SemaphoreSet>, L<Coro::RWLock>.
574		605
575	Event/IO: L<Coro::Timer>, L<Coro::Event>, L<Coro::Handle>, L<Coro::Socket>, L<Coro::Select>.	606	Event/IO: L<Coro::Timer>, L<Coro::Event>, L<Coro::Handle>, L<Coro::Socket>, L<Coro::Select>.
576		607

Diff Legend

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

Comparing Coro/Coro.pm (file contents): Revision 1.125 by root, Fri Apr 27 19:35:58 2007 UTC vs. Revision 1.148 by root, Fri Oct 5 20:11:25 2007 UTC

Diff Legend

Comparing Coro/Coro.pm (file contents):
Revision 1.125 by root, Fri Apr 27 19:35:58 2007 UTC vs.
Revision 1.148 by root, Fri Oct 5 20:11:25 2007 UTC