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

Comparing Coro/Coro.pm (file contents):
Revision 1.7 by root, Fri Jul 13 13:05:38 2001 UTC vs.
Revision 1.14 by root, Tue Jul 17 02:21:56 2001 UTC

1	=head1 NAME	1	=head1 NAME
2		2
3	Coro - create and manage simple coroutines	3	Coro - coroutine process abstraction
4		4
5	=head1 SYNOPSIS	5	=head1 SYNOPSIS
6		6
7	use Coro;	7	use Coro;
8		8
9	$new = new Coro sub {	9	async {
10	print "in coroutine, switching back\n";	10	# some asynchronous thread of execution
11	$new->transfer($main);
12	print "in coroutine again, switching back\n";
13	$new->transfer($main);
14	};	11	};
15		12
16	$main = new Coro;	13	# alternatively create an async process like this:
17		14
18	print "in main, switching to coroutine\n";	15	sub some_func : Coro {
19	$main->transfer($new);	16	# some more async code
20	print "back in main, switch to coroutine again\n";	17	}
21	$main->transfer($new);	18
22	print "back in main\n";	19	yield;
23		20
24	=head1 DESCRIPTION	21	=head1 DESCRIPTION
25		22
26	This module implements coroutines. Coroutines, similar to continuations,	23	This module collection manages coroutines. Coroutines are similar to
27	allow you to run more than one "thread of execution" in parallel. Unlike	24	Threads but don't run in parallel.
28	threads this, only voluntary switching is used so locking problems are
29	greatly reduced.
30		25
31	Although this is the "main" module of the Coro family it provides only	26	This module is still experimental, see the BUGS section below.
32	low-level functionality. See L<Coro::Process> and related modules for a	27
33	more useful process abstraction including scheduling.	28	=cut
		29
		30	package Coro;
		31
		32	use Coro::State;
		33
		34	use base Exporter;
		35
		36	$VERSION = 0.05;
		37
		38	@EXPORT = qw(async yield schedule terminate);
		39	@EXPORT_OK = qw($current);
		40
		41	{
		42	use subs 'async';
		43
		44	my @async;
		45
		46	# this way of handling attributes simply is NOT scalable ;()
		47	sub import {
		48	Coro->export_to_level(1, @_);
		49	my $old = *{(caller)[0]."::MODIFY_CODE_ATTRIBUTES"}{CODE};
		50	*{(caller)[0]."::MODIFY_CODE_ATTRIBUTES"} = sub {
		51	my ($package, $ref) = (shift, shift);
		52	my @attrs;
		53	for (@_) {
		54	if ($_ eq "Coro") {
		55	push @async, $ref;
		56	} else {
		57	push @attrs, @_;
		58	}
		59	}
		60	return $old ? $old->($package, $name, @attrs) : @attrs;
		61	};
		62	}
		63
		64	sub INIT {
		65	async pop @async while @async;
		66	}
		67	}
		68
		69	=item $main
		70
		71	This coroutine represents the main program.
		72
		73	=cut
		74
		75	our $main = new Coro;
		76
		77	=item $current
		78
		79	The current coroutine (the last coroutine switched to). The initial value is C<$main> (of course).
		80
		81	=cut
		82
		83	# maybe some other module used Coro::Specific before...
		84	if ($current) {
		85	$main->{specific} = $current->{specific};
		86	}
		87
		88	our $current = $main;
		89
		90	=item $idle
		91
		92	The coroutine to switch to when no other coroutine is running. The default
		93	implementation prints "FATAL: deadlock detected" and exits.
		94
		95	=cut
		96
		97	# should be done using priorities :(
		98	our $idle = new Coro sub {
		99	print STDERR "FATAL: deadlock detected\n";
		100	exit(51);
		101	};
		102
		103	# we really need priorities...
		104	## my @ready; #d#
		105	our @ready = (); # the ready queue. hehe, rather broken ;)
		106
		107	# static methods. not really.
		108
		109	=head2 STATIC METHODS
		110
		111	Static methods are actually functions that operate on the current process only.
34		112
35	=over 4	113	=over 4
36		114
37	=cut	115	=item async { ... } [@args...]
38		116
39	package Coro;	117	Create a new asynchronous process and return it's process object
		118	(usually unused). When the sub returns the new process is automatically
		119	terminated.
40		120
41	BEGIN {	121	# create a new coroutine that just prints its arguments
42	$VERSION = 0.03;	122	async {
		123	print "@_\n";
		124	} 1,2,3,4;
43		125
44	require XSLoader;	126	The coderef you submit MUST NOT be a closure that refers to variables
45	XSLoader::load Coro, $VERSION;	127	in an outer scope. This does NOT work. Pass arguments into it instead.
46	}
47		128
48	=item $coro = new [$coderef [, @args]]
49
50	Create a new coroutine and return it. The first C<transfer> call to this
51	coroutine will start execution at the given coderef. If, the subroutine
52	returns it will be executed again.
53
54	If the coderef is omitted this function will create a new "empty"
55	coroutine, i.e. a coroutine that cannot be transfered to but can be used
56	to save the current coroutine in.
57
58	=cut	129	=cut
		130
		131	sub async(&@) {
		132	my $pid = new Coro @_;
		133	$pid->ready;
		134	$pid;
		135	}
		136
		137	=item schedule
		138
		139	Calls the scheduler. Please note that the current process will not be put
		140	into the ready queue, so calling this function usually means you will
		141	never be called again.
		142
		143	=cut
		144
		145	my $prev;
		146
		147	sub schedule {
		148	# should be done using priorities :(
		149	($prev, $current) = ($current, shift @ready \|\| $idle);
		150	Coro::State::transfer($prev, $current);
		151	}
		152
		153	=item yield
		154
		155	Yield to other processes. This function puts the current process into the
		156	ready queue and calls C<schedule>.
		157
		158	=cut
		159
		160	sub yield {
		161	$current->ready;
		162	&schedule;
		163	}
		164
		165	=item terminate
		166
		167	Terminates the current process.
		168
		169	Future versions of this function will allow result arguments.
		170
		171	=cut
		172
		173	sub terminate {
		174	$current->{_results} = [@_];
		175	&schedule;
		176	}
		177
		178	=back
		179
		180	# dynamic methods
		181
		182	=head2 PROCESS METHODS
		183
		184	These are the methods you can call on process objects.
		185
		186	=over 4
		187
		188	=item new Coro \&sub [, @args...]
		189
		190	Create a new process and return it. When the sub returns the process
		191	automatically terminates. To start the process you must first put it into
		192	the ready queue by calling the ready method.
		193
		194	The coderef you submit MUST NOT be a closure that refers to variables
		195	in an outer scope. This does NOT work. Pass arguments into it instead.
		196
		197	=cut
		198
		199	sub _newcoro {
		200	terminate &{+shift};
		201	}
59		202
60	sub new {	203	sub new {
61	my $class = $_[0];	204	my $class = shift;
62	my $proc = $_[1] \|\| sub { die "tried to transfer to an empty coroutine" };	205	bless {
63	bless _newprocess {	206	_coro_state => (new Coro::State $_[0] && \&_newcoro, @_),
64	do {
65	eval { &$proc };
66	if ($@) {
67	$error_msg = $@;
68	$error_coro = _newprocess { };
69	&transfer($error_coro, $error);
70	}
71	} while (1);
72	}, $class;	207	}, $class;
73	}	208	}
74		209
75	=item $prev->transfer($next)	210	=item $process->ready
76		211
77	Save the state of the current subroutine in C<$prev> and switch to the	212	Put the current process into the ready queue.
78	coroutine saved in C<$next>.
79		213
80	The "state" of a subroutine only ever includes scope, i.e. lexical
81	variables and the current execution state. It does not save/restore any
82	global variables such as C<$_> or C<$@> or any other special or non
83	special variables. So remember that every function call that might call
84	C<transfer> (such as C<Coro::Channel::put>) might clobber any global
85	and/or special variables. Yes, this is by design ;) You cna always create
86	your own process abstraction model that saves these variables.
87
88	The easiest way to do this is to create your own scheduling primitive like this:
89
90	sub schedule {
91	local ($_, $@, ...);
92	$old->transfer($new);
93	}
94
95	=cut	214	=cut
96		215
97	# I call the _transfer function from a perl function	216	sub ready {
98	# because that way perl saves all important things on	217	push @ready, $_[0];
99	# the stack. Actually, I'd do it from within XS, but
100	# I couldn't get it to work.
101	sub transfer {
102	_transfer($_[0], $_[1]);
103	}	218	}
104		219
105	=item $error, $error_msg, $error_coro	220	=back
106		221
107	This coroutine will be called on fatal errors. C<$error_msg> and
108	C<$error_coro> return the error message and the error-causing coroutine
109	(NOT an object) respectively. This API might change.
110
111	=cut	222	=cut
112
113	$error_msg =
114	$error_coro = undef;
115
116	$error = _newprocess {
117	print STDERR "FATAL: $error_msg\nprogram aborted\n";
118	exit 50;
119	};
120		223
121	1;	224	1;
122		225
123	=back
124
125	=head1 BUGS	226	=head1 BUGS
126		227
127	This module has not yet been extensively tested.	228	- could be faster, especially when the core would introduce special
		229	support for coroutines (like it does for threads).
		230	- there is still a memleak on coroutine termination that I could not
		231	identify. Could be as small as a single SV.
		232	- this module is not well-tested.
128		233
129	=head1 SEE ALSO	234	=head1 SEE ALSO
130		235
131	L<Coro::Process>, L<Coro::Signal>.	236	L<Coro::Channel>, L<Coro::Cont>, L<Coro::Specific>, L<Coro::Semaphore>,
		237	L<Coro::Signal>, L<Coro::State>, L<Coro::Event>.
132		238
133	=head1 AUTHOR	239	=head1 AUTHOR
134		240
135	Marc Lehmann <pcg@goof.com>	241	Marc Lehmann <pcg@goof.com>
136	http://www.goof.com/pcg/marc/	242	http://www.goof.com/pcg/marc/

Diff Legend

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

Comparing Coro/Coro.pm (file contents): Revision 1.7 by root, Fri Jul 13 13:05:38 2001 UTC vs. Revision 1.14 by root, Tue Jul 17 02:21:56 2001 UTC

Diff Legend

Comparing Coro/Coro.pm (file contents):
Revision 1.7 by root, Fri Jul 13 13:05:38 2001 UTC vs.
Revision 1.14 by root, Tue Jul 17 02:21:56 2001 UTC