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

Comparing Coro/Coro.pm (file contents):
Revision 1.128 by root, Wed Sep 19 21:39:15 2007 UTC vs.
Revision 1.149 by root, Sat Oct 6 00:39:07 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.7';	55	our $VERSION = '4.02';
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) \|\| do {
255	my $coro = new Coro \&pool_handler;	267	my $coro = (pop @async_pool) \|\| new Coro \&pool_handler;
256	$coro->{desc} = "async_pool";
257	$coro
258	};
259		268
260	$coro->{_invoke} = [@_];	269	$coro->{_invoke} = [@_];
261	$coro->ready;	270	$coro->ready;
262		271
263	$coro	272	$coro
…		…
306		315
307	=item terminate [arg...]	316	=item terminate [arg...]
308		317
309	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>).
310		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
311	=cut	326	=cut
312		327
313	sub terminate {	328	sub terminate {
314	$current->cancel (@_);	329	$current->cancel (@_);
		330	}
		331
		332	sub killall {
		333	for (Coro::State::list) {
		334	$_->cancel
		335	if $_ != $current && UNIVERSAL::isa $_, "Coro";
		336	}
315	}	337	}
316		338
317	=back	339	=back
318		340
319	# dynamic methods	341	# dynamic methods
…		…
329	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
330	automatically terminates as if C<terminate> with the returned values were	352	automatically terminates as if C<terminate> with the returned values were
331	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
332	by calling the ready method.	354	by calling the ready method.
333		355
334	See C<async> for additional discussion.	356	See C<async> and C<Coro::State::new> for additional info about the
		357	coroutine environment.
335		358
336	=cut	359	=cut
337		360
338	sub _run_coro {	361	sub _run_coro {
339	terminate &{+shift};	362	terminate &{+shift};
…		…
363		386
364	=cut	387	=cut
365		388
366	sub cancel {	389	sub cancel {
367	my $self = shift;	390	my $self = shift;
368	$self->{status} = [@_];	391	$self->{_status} = [@_];
369		392
370	if ($current == $self) {	393	if ($current == $self) {
371	push @destroy, $self;	394	push @destroy, $self;
372	$manager->ready;	395	$manager->ready;
373	&schedule while 1;	396	&schedule while 1;
…		…
377	}	400	}
378		401
379	=item $coroutine->join	402	=item $coroutine->join
380		403
381	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
382	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
383	from multiple coroutine.	406	from multiple coroutines.
384		407
385	=cut	408	=cut
386		409
387	sub join {	410	sub join {
388	my $self = shift;	411	my $self = shift;
389		412
390	unless ($self->{status}) {	413	unless ($self->{_status}) {
391	my $current = $current;	414	my $current = $current;
392		415
393	push @{$self->{destroy_cb}}, sub {	416	push @{$self->{_on_destroy}}, sub {
394	$current->ready;	417	$current->ready;
395	undef $current;	418	undef $current;
396	};	419	};
397		420
398	&schedule while $current;	421	&schedule while $current;
399	}	422	}
400		423
401	wantarray ? @{$self->{status}} : $self->{status}[0];	424	wantarray ? @{$self->{_status}} : $self->{_status}[0];
402	}	425	}
403		426
404	=item $coroutine->on_destroy (\&cb)	427	=item $coroutine->on_destroy (\&cb)
405		428
406	Registers a callback that is called when this coroutine gets destroyed,	429	Registers a callback that is called when this coroutine gets destroyed,
…		…
410	=cut	433	=cut
411		434
412	sub on_destroy {	435	sub on_destroy {
413	my ($self, $cb) = @_;	436	my ($self, $cb) = @_;
414		437
415	push @{ $self->{destroy_cb} }, $cb;	438	push @{ $self->{_on_destroy} }, $cb;
416	}	439	}
417		440
418	=item $oldprio = $coroutine->prio ($newprio)	441	=item $oldprio = $coroutine->prio ($newprio)
419		442
420	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
…		…
444		467
445	=item $olddesc = $coroutine->desc ($newdesc)	468	=item $olddesc = $coroutine->desc ($newdesc)
446		469
447	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
448	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.
449		475
450	=cut	476	=cut
451		477
452	sub desc {	478	sub desc {
453	my $old = $_[0]{desc};	479	my $old = $_[0]{desc};
…		…
529		555
530	# we create a special coro because we want to cede,	556	# we create a special coro because we want to cede,
531	# to reduce pressure on the coro pool (because most callbacks	557	# to reduce pressure on the coro pool (because most callbacks
532	# return immediately and can be reused) and because we cannot cede	558	# return immediately and can be reused) and because we cannot cede
533	# inside an event callback.	559	# inside an event callback.
534	our $unblock_scheduler = async {	560	our $unblock_scheduler = new Coro sub {
535	while () {	561	while () {
536	while (my $cb = pop @unblock_queue) {	562	while (my $cb = pop @unblock_queue) {
537	# this is an inlined copy of async_pool	563	# this is an inlined copy of async_pool
538	my $coro = (pop @pool or new Coro \&pool_handler);	564	my $coro = (pop @async_pool) \|\| new Coro \&pool_handler;
539		565
540	$coro->{_invoke} = $cb;	566	$coro->{_invoke} = $cb;
541	$coro->ready;	567	$coro->ready;
542	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
543	}	569	}
544	schedule; # sleep well	570	schedule; # sleep well
545	}	571	}
546	};	572	};
		573	$unblock_scheduler->desc ("[unblock_sub scheduler]");
547		574
548	sub unblock_sub(&) {	575	sub unblock_sub(&) {
549	my $cb = shift;	576	my $cb = shift;
550		577
551	sub {	578	sub {
…		…
570	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
571	this).	598	this).
572		599
573	=head1 SEE ALSO	600	=head1 SEE ALSO
574		601
575	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>.
576		603
577	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>.
578		605
579	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>.
580		607

Diff Legend

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

Comparing Coro/Coro.pm (file contents): Revision 1.128 by root, Wed Sep 19 21:39:15 2007 UTC vs. Revision 1.149 by root, Sat Oct 6 00:39:07 2007 UTC

Diff Legend

Comparing Coro/Coro.pm (file contents):
Revision 1.128 by root, Wed Sep 19 21:39:15 2007 UTC vs.
Revision 1.149 by root, Sat Oct 6 00:39:07 2007 UTC