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

Comparing Coro/Coro.pm (file contents):
Revision 1.8 by root, Sat Jul 14 22:14:21 2001 UTC vs.
Revision 1.34 by root, Sun Sep 16 01:34:35 2001 UTC

…		…
14		14
15	sub some_func : Coro {	15	sub some_func : Coro {
16	# some more async code	16	# some more async code
17	}	17	}
18		18
19	yield;	19	cede;
20		20
21	=head1 DESCRIPTION	21	=head1 DESCRIPTION
22		22
		23	This module collection manages coroutines. Coroutines are similar to
		24	Threads but don't run in parallel.
		25
		26	This module is still experimental, see the BUGS section below.
		27
		28	In this module, coroutines are defined as "callchain + lexical variables
		29	+ @_ + $_ + $@ + $^W + C stack), that is, a coroutine has it's own
		30	callchain, it's own set of lexicals and it's own set of perl's most
		31	important global variables.
		32
23	=cut	33	=cut
24		34
25	package Coro;	35	package Coro;
26		36
27	use Coro::State;	37	use Coro::State;
28		38
29	use base Exporter;	39	use base Exporter;
30		40
31	$VERSION = 0.03;	41	$VERSION = 0.5;
32		42
33	@EXPORT = qw(async yield schedule);	43	@EXPORT = qw(async cede schedule terminate current);
34	@EXPORT_OK = qw($current);	44	%EXPORT_TAGS = (
		45	prio => [qw(PRIO_MAX PRIO_HIGH PRIO_NORMAL PRIO_LOW PRIO_IDLE PRIO_MIN)],
		46	);
		47	@EXPORT_OK = @{$EXPORT_TAGS{prio}};
35		48
36	{	49	{
37	use subs 'async';
38
39	my @async;	50	my @async;
		51	my $init;
40		52
41	# this way of handling attributes simply is NOT scalable ;()	53	# this way of handling attributes simply is NOT scalable ;()
42	sub import {	54	sub import {
43	Coro->export_to_level(1, @_);	55	Coro->export_to_level(1, @_);
44	my $old = *{(caller)[0]."::MODIFY_CODE_ATTRIBUTES"}{CODE};	56	my $old = *{(caller)[0]."::MODIFY_CODE_ATTRIBUTES"}{CODE};
…		…
46	my ($package, $ref) = (shift, shift);	58	my ($package, $ref) = (shift, shift);
47	my @attrs;	59	my @attrs;
48	for (@_) {	60	for (@_) {
49	if ($_ eq "Coro") {	61	if ($_ eq "Coro") {
50	push @async, $ref;	62	push @async, $ref;
		63	unless ($init++) {
		64	eval q{
		65	sub INIT {
		66	&async(pop @async) while @async;
		67	}
		68	};
		69	}
51	} else {	70	} else {
52	push @attrs, @_;	71	push @attrs, $_;
53	}	72	}
54	}	73	}
55	return $old ? $old->($package, $name, @attrs) : @attrs;	74	return $old ? $old->($package, $ref, @attrs) : @attrs;
56	};	75	};
57	}	76	}
58		77
59	sub INIT {
60	async pop @async while @async;
61	}
62	}	78	}
63
64	my $idle = new Coro sub {
65	&yield while 1;
66	};
67		79
68	=item $main	80	=item $main
69		81
70	This coroutine represents the main program.	82	This coroutine represents the main program.
71		83
72	=cut	84	=cut
73		85
74	$main = new Coro;	86	our $main = new Coro;
75		87
76	=item $current	88	=item $current (or as function: current)
77		89
78	The current coroutine (the last coroutine switched to). The initial value is C<$main> (of course).	90	The current coroutine (the last coroutine switched to). The initial value is C<$main> (of course).
79		91
80	=cut	92	=cut
81		93
82	# maybe some other module used Coro::Specific before...	94	# maybe some other module used Coro::Specific before...
83	if ($current) {	95	if ($current) {
84	$main->{specific} = $current->{specific};	96	$main->{specific} = $current->{specific};
85	}	97	}
86		98
87	$current = $main;	99	our $current = $main;
88		100
89	# we really need priorities...	101	sub current() { $current }
90	my @ready = (); # the ready queue. hehe, rather broken ;)	102
		103	=item $idle
		104
		105	The coroutine to switch to when no other coroutine is running. The default
		106	implementation prints "FATAL: deadlock detected" and exits.
		107
		108	=cut
		109
		110	# should be done using priorities :(
		111	our $idle = new Coro sub {
		112	print STDERR "FATAL: deadlock detected\n";
		113	exit(51);
		114	};
		115
		116	# this coroutine is necessary because a coroutine
		117	# cannot destroy itself.
		118	my @destroy;
		119	my $manager = new Coro sub {
		120	while() {
		121	delete ((pop @destroy)->{_coro_state}) while @destroy;
		122	&schedule;
		123	}
		124	};
91		125
92	# static methods. not really.	126	# static methods. not really.
93		127
94	=head2 STATIC METHODS	128	=head2 STATIC METHODS
95		129
96	Static methods are actually functions that operate on the current process only.	130	Static methods are actually functions that operate on the current process only.
97		131
98	=over 4	132	=over 4
99		133
100	=item async { ... };	134	=item async { ... } [@args...]
101		135
102	Create a new asynchronous process and return it's process object	136	Create a new asynchronous process and return it's process object
103	(usually unused). When the sub returns the new process is automatically	137	(usually unused). When the sub returns the new process is automatically
104	terminated.	138	terminated.
105		139
106	=cut	140	# create a new coroutine that just prints its arguments
		141	async {
		142	print "@_\n";
		143	} 1,2,3,4;
107		144
		145	The coderef you submit MUST NOT be a closure that refers to variables
		146	in an outer scope. This does NOT work. Pass arguments into it instead.
		147
		148	=cut
		149
108	sub async(&) {	150	sub async(&@) {
109	(new Coro $_[0])->ready;	151	my $pid = new Coro @_;
		152	$manager->ready; # this ensures that the stack is cloned from the manager
		153	$pid->ready;
		154	$pid;
110	}	155	}
111		156
112	=item schedule	157	=item schedule
113		158
114	Calls the scheduler. Please note that the current process will not be put	159	Calls the scheduler. Please note that the current process will not be put
115	into the ready queue, so calling this function usually means you will	160	into the ready queue, so calling this function usually means you will
116	never be called again.	161	never be called again.
117		162
118	=cut	163	=cut
119		164
120	my $prev;
121
122	sub schedule {
123	($prev, $current) = ($current, shift @ready);
124	Coro::State::transfer($prev, $current);
125	}
126
127	=item yield	165	=item cede
128		166
129	Yield to other processes. This function puts the current process into the	167	"Cede" to other processes. This function puts the current process into the
130	ready queue and calls C<schedule>.	168	ready queue and calls C<schedule>, which has the effect of giving up the
		169	current "timeslice" to other coroutines of the same or higher priority.
131		170
132	=cut	171	=cut
133		172
134	sub yield {	173	=item terminate
		174
		175	Terminates the current process.
		176
		177	Future versions of this function will allow result arguments.
		178
		179	=cut
		180
		181	sub terminate {
135	$current->ready;	182	$current->cancel;
136	&schedule;	183	&schedule;
137	}	184	die; # NORETURN
138
139	=item terminate
140
141	Terminates the current process.
142
143	=cut
144
145	sub terminate {
146	&schedule;
147	}	185	}
148		186
149	=back	187	=back
150		188
151	# dynamic methods	189	# dynamic methods
…		…
154		192
155	These are the methods you can call on process objects.	193	These are the methods you can call on process objects.
156		194
157	=over 4	195	=over 4
158		196
159	=item new Coro \⊂	197	=item new Coro \&sub [, @args...]
160		198
161	Create a new process and return it. When the sub returns the process	199	Create a new process and return it. When the sub returns the process
162	automatically terminates. To start the process you must first put it into	200	automatically terminates. To start the process you must first put it into
163	the ready queue by calling the ready method.	201	the ready queue by calling the ready method.
164		202
		203	The coderef you submit MUST NOT be a closure that refers to variables
		204	in an outer scope. This does NOT work. Pass arguments into it instead.
		205
165	=cut	206	=cut
		207
		208	sub _newcoro {
		209	terminate &{+shift};
		210	}
166		211
167	sub new {	212	sub new {
168	my $class = shift;	213	my $class = shift;
169	my $proc = $_[0];
170	bless {	214	bless {
171	_coro_state => new Coro::State ($proc ? sub { &$proc; &terminate } : $proc),	215	_coro_state => (new Coro::State $_[0] && \&_newcoro, @_),
172	}, $class;	216	}, $class;
173	}	217	}
174		218
175	=item $process->ready	219	=item $process->ready
176		220
177	Put the current process into the ready queue.	221	Put the current process into the ready queue.
178		222
179	=cut	223	=cut
180		224
181	sub ready {	225	=item $process->cancel
		226
		227	Like C<terminate>, but terminates the specified process instead.
		228
		229	=cut
		230
		231	sub cancel {
182	push @ready, $_[0];	232	push @destroy, $_[0];
		233	$manager->ready;
		234	}
		235
		236	=item $oldprio = $process->prio($newprio)
		237
		238	Sets the priority of the process. Higher priority processes get run before
		239	lower priority processes. Priorities are smalled signed integer (currently
		240	-4 .. +3), that you can refer to using PRIO_xxx constants (use the import
		241	tag :prio to get then):
		242
		243	PRIO_MAX > PRIO_HIGH > PRIO_NORMAL > PRIO_LOW > PRIO_IDLE > PRIO_MIN
		244	3 > 1 > 0 > -1 > -3 > -4
		245
		246	# set priority to HIGH
		247	current->prio(PRIO_HIGH);
		248
		249	The idle coroutine ($Coro::idle) always has a lower priority than any
		250	existing coroutine.
		251
		252	Changing the priority of the current process will take effect immediately,
		253	but changing the priority of processes in the ready queue (but not
		254	running) will only take effect after the next schedule (of that
		255	process). This is a bug that will be fixed in some future version.
		256
		257	=cut
		258
		259	sub prio {
		260	my $old = $_[0]{prio};
		261	$_[0]{prio} = $_[1] if @_ > 1;
		262	$old;
		263	}
		264
		265	=item $newprio = $process->nice($change)
		266
		267	Similar to C<prio>, but subtract the given value from the priority (i.e.
		268	higher values mean lower priority, just as in unix).
		269
		270	=cut
		271
		272	sub nice {
		273	$_[0]{prio} -= $_[1];
183	}	274	}
184		275
185	=back	276	=back
186		277
187	=cut	278	=cut
188		279
189	1;	280	1;
		281
		282	=head1 BUGS/LIMITATIONS
		283
		284	- you must make very sure that no coro is still active on global destruction.
		285	very bad things might happen otherwise (usually segfaults).
		286	- this module is not thread-safe. You must only ever use this module from
		287	the same thread (this requirement might be loosened in the future to
		288	allow per-thread schedulers, but Coro::State does not yet allow this).
		289
		290	=head1 SEE ALSO
		291
		292	L<Coro::Channel>, L<Coro::Cont>, L<Coro::Specific>, L<Coro::Semaphore>,
		293	L<Coro::Signal>, L<Coro::State>, L<Coro::Event>, L<Coro::RWLock>,
		294	L<Coro::Handle>, L<Coro::Socket>.
190		295
191	=head1 AUTHOR	296	=head1 AUTHOR
192		297
193	Marc Lehmann <pcg@goof.com>	298	Marc Lehmann <pcg@goof.com>
194	http://www.goof.com/pcg/marc/	299	http://www.goof.com/pcg/marc/

Diff Legend

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

Comparing Coro/Coro.pm (file contents): Revision 1.8 by root, Sat Jul 14 22:14:21 2001 UTC vs. Revision 1.34 by root, Sun Sep 16 01:34:35 2001 UTC

Diff Legend

Comparing Coro/Coro.pm (file contents):
Revision 1.8 by root, Sat Jul 14 22:14:21 2001 UTC vs.
Revision 1.34 by root, Sun Sep 16 01:34:35 2001 UTC