ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro/Coro.pm
(Generate patch)

Comparing Coro/Coro.pm (file contents):
Revision 1.4 by root, Tue Jul 3 05:05:45 2001 UTC vs.
Revision 1.31 by root, Sat Aug 11 23:10:56 2001 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines