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

Comparing Coro/Coro.pm (file contents):
Revision 1.129 by root, Wed Sep 19 22:33:08 2007 UTC vs.
Revision 1.146 by root, Wed Oct 3 17:37:33 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.0';
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;
161	my $manager;	163	my $manager;
162		164
163	$manager = new Coro sub {	165	$manager = new Coro sub {
164	$current->desc ("[coro manager]");
165
166	while () {	166	while () {
167	(shift @destroy)->_cancel	167	(shift @destroy)->_cancel
168	while @destroy;	168	while @destroy;
169		169
170	&schedule;	170	&schedule;
171	}	171	}
172	};	172	};
173		173	$manager->desc ("[coro manager]");
174	$manager->prio (PRIO_MAX);	174	$manager->prio (PRIO_MAX);
175		175
176	# static methods. not really.	176	# static methods. not really.
177		177
178	=back	178	=back
…		…
186	=item async { ... } [@args...]	186	=item async { ... } [@args...]
187		187
188	Create a new asynchronous coroutine and return it's coroutine object	188	Create a new asynchronous coroutine and return it's coroutine object
189	(usually unused). When the sub returns the new coroutine is automatically	189	(usually unused). When the sub returns the new coroutine is automatically
190	terminated.	190	terminated.
		191
		192	See the C<Coro::State::new> constructor for info about the coroutine
		193	environment.
191		194
192	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
193	the coroutine. Likewise, when the coroutine dies, the program will exit,	196	the coroutine. Likewise, when the coroutine dies, the program will exit,
194	just as it would in the main program.	197	just as it would in the main program.
195		198
…		…
216	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
217	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>
218	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,
219	which somehow defeats the purpose of pooling.	222	which somehow defeats the purpose of pooling.
220		223
221	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
222	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 $/ >.
223		230
224	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
225	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
226	required.	233	required.
227		234
228	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
229	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
230	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.
231		240
232	=cut	241	=cut
233		242
234	our $POOL_SIZE = 8;	243	our $POOL_SIZE = 8;
		244	our $POOL_RSS = 16 * 1024;
235	our @pool;	245	our @async_pool;
236		246
237	sub pool_handler {	247	sub pool_handler {
		248	my $cb;
		249
238	while () {	250	while () {
239	$current->{desc} = "[async_pool]";
240
241	eval {	251	eval {
242	my ($cb, @arg) = @{ delete $current->{_invoke} or return };	252	while () {
243	$cb->(@arg);	253	_pool_1 $cb;
		254	&$cb;
		255	_pool_2 $cb;
		256	&schedule;
		257	}
244	};	258	};
		259
		260	last if $@ eq "\3terminate\2\n";
245	warn $@ if $@;	261	warn $@ if $@;
246
247	last if @pool >= $POOL_SIZE;
248
249	push @pool, $current;
250	$current->{desc} = "[async_pool idle]";
251	$current->save (Coro::State::SAVE_DEF);
252	$current->prio (0);
253	schedule;
254	}	262	}
255	}	263	}
256		264
257	sub async_pool(&@) {	265	sub async_pool(&@) {
258	# this is also inlined into the unlock_scheduler	266	# this is also inlined into the unlock_scheduler
259	my $coro = (pop @pool) \|\| new Coro \&pool_handler;;	267	my $coro = (pop @async_pool) \|\| new Coro \&pool_handler;
260		268
261	$coro->{_invoke} = [@_];	269	$coro->{_invoke} = [@_];
262	$coro->ready;	270	$coro->ready;
263		271
264	$coro	272	$coro
…		…
307		315
308	=item terminate [arg...]	316	=item terminate [arg...]
309		317
310	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>).
311		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
312	=cut	326	=cut
313		327
314	sub terminate {	328	sub terminate {
315	$current->cancel (@_);	329	$current->cancel (@_);
		330	}
		331
		332	sub killall {
		333	for (Coro::State::list) {
		334	$_->cancel
		335	if $_ != $current && UNIVERSAL::isa $_, "Coro";
		336	}
316	}	337	}
317		338
318	=back	339	=back
319		340
320	# dynamic methods	341	# dynamic methods
…		…
330	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
331	automatically terminates as if C<terminate> with the returned values were	352	automatically terminates as if C<terminate> with the returned values were
332	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
333	by calling the ready method.	354	by calling the ready method.
334		355
335	See C<async> for additional discussion.	356	See C<async> and C<Coro::State::new> for additional info about the
		357	coroutine environment.
336		358
337	=cut	359	=cut
338		360
339	sub _run_coro {	361	sub _run_coro {
340	terminate &{+shift};	362	terminate &{+shift};
…		…
364		386
365	=cut	387	=cut
366		388
367	sub cancel {	389	sub cancel {
368	my $self = shift;	390	my $self = shift;
369	$self->{status} = [@_];	391	$self->{_status} = [@_];
370		392
371	if ($current == $self) {	393	if ($current == $self) {
372	push @destroy, $self;	394	push @destroy, $self;
373	$manager->ready;	395	$manager->ready;
374	&schedule while 1;	396	&schedule while 1;
…		…
378	}	400	}
379		401
380	=item $coroutine->join	402	=item $coroutine->join
381		403
382	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
383	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
384	from multiple coroutine.	406	from multiple coroutines.
385		407
386	=cut	408	=cut
387		409
388	sub join {	410	sub join {
389	my $self = shift;	411	my $self = shift;
390		412
391	unless ($self->{status}) {	413	unless ($self->{_status}) {
392	my $current = $current;	414	my $current = $current;
393		415
394	push @{$self->{destroy_cb}}, sub {	416	push @{$self->{_on_destroy}}, sub {
395	$current->ready;	417	$current->ready;
396	undef $current;	418	undef $current;
397	};	419	};
398		420
399	&schedule while $current;	421	&schedule while $current;
400	}	422	}
401		423
402	wantarray ? @{$self->{status}} : $self->{status}[0];	424	wantarray ? @{$self->{_status}} : $self->{_status}[0];
403	}	425	}
404		426
405	=item $coroutine->on_destroy (\&cb)	427	=item $coroutine->on_destroy (\&cb)
406		428
407	Registers a callback that is called when this coroutine gets destroyed,	429	Registers a callback that is called when this coroutine gets destroyed,
…		…
411	=cut	433	=cut
412		434
413	sub on_destroy {	435	sub on_destroy {
414	my ($self, $cb) = @_;	436	my ($self, $cb) = @_;
415		437
416	push @{ $self->{destroy_cb} }, $cb;	438	push @{ $self->{_on_destroy} }, $cb;
417	}	439	}
418		440
419	=item $oldprio = $coroutine->prio ($newprio)	441	=item $oldprio = $coroutine->prio ($newprio)
420		442
421	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
…		…
445		467
446	=item $olddesc = $coroutine->desc ($newdesc)	468	=item $olddesc = $coroutine->desc ($newdesc)
447		469
448	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
449	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.
450		475
451	=cut	476	=cut
452		477
453	sub desc {	478	sub desc {
454	my $old = $_[0]{desc};	479	my $old = $_[0]{desc};
…		…
530		555
531	# we create a special coro because we want to cede,	556	# we create a special coro because we want to cede,
532	# to reduce pressure on the coro pool (because most callbacks	557	# to reduce pressure on the coro pool (because most callbacks
533	# return immediately and can be reused) and because we cannot cede	558	# return immediately and can be reused) and because we cannot cede
534	# inside an event callback.	559	# inside an event callback.
535	our $unblock_scheduler = async {	560	our $unblock_scheduler = new Coro sub {
536	$current->desc ("[unblock_sub scheduler]");
537	while () {	561	while () {
538	while (my $cb = pop @unblock_queue) {	562	while (my $cb = pop @unblock_queue) {
539	# this is an inlined copy of async_pool	563	# this is an inlined copy of async_pool
540	my $coro = (pop @pool or new Coro \&pool_handler);	564	my $coro = (pop @async_pool) \|\| new Coro \&pool_handler;
541		565
542	$coro->{_invoke} = $cb;	566	$coro->{_invoke} = $cb;
543	$coro->ready;	567	$coro->ready;
544	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
545	}	569	}
546	schedule; # sleep well	570	schedule; # sleep well
547	}	571	}
548	};	572	};
		573	$unblock_scheduler->desc ("[unblock_sub scheduler]");
549		574
550	sub unblock_sub(&) {	575	sub unblock_sub(&) {
551	my $cb = shift;	576	my $cb = shift;
552		577
553	sub {	578	sub {

Diff Legend

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

Comparing Coro/Coro.pm (file contents): Revision 1.129 by root, Wed Sep 19 22:33:08 2007 UTC vs. Revision 1.146 by root, Wed Oct 3 17:37:33 2007 UTC

Diff Legend

Comparing Coro/Coro.pm (file contents):
Revision 1.129 by root, Wed Sep 19 22:33:08 2007 UTC vs.
Revision 1.146 by root, Wed Oct 3 17:37:33 2007 UTC