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

Comparing Coro/Coro.pm (file contents):
Revision 1.5 by root, Tue Jul 10 01:43:21 2001 UTC vs.
Revision 1.17 by root, Thu Jul 19 02:45:09 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 yield;
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. 28=cut
29
30package Coro;
31
32use Coro::State;
33
34use base Exporter;
35
36$VERSION = 0.08;
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, $ref, @attrs) : @attrs;
61 };
62 }
63
64 sub INIT {
65 async pop @async while @async;
66 }
67}
68
69=item $main
70
71This coroutine represents the main program.
72
73=cut
74
75our $main = new Coro;
76
77=item $current
78
79The 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...
84if ($current) {
85 $main->{specific} = $current->{specific};
86}
87
88our $current = $main;
89
90=item $idle
91
92The coroutine to switch to when no other coroutine is running. The default
93implementation prints "FATAL: deadlock detected" and exits.
94
95=cut
96
97# should be done using priorities :(
98our $idle = new Coro sub {
99 print STDERR "FATAL: deadlock detected\n";
100 exit(51);
101};
102
103# we really need priorities...
104my @ready; # the ready queue. hehe, rather broken ;)
105
106# static methods. not really.
107
108=head2 STATIC METHODS
109
110Static methods are actually functions that operate on the current process only.
32 111
33=over 4 112=over 4
34 113
35=cut 114=item async { ... } [@args...]
36 115
37package Coro; 116Create a new asynchronous process and return it's process object
117(usually unused). When the sub returns the new process is automatically
118terminated.
38 119
39BEGIN { 120 # create a new coroutine that just prints its arguments
40 $VERSION = 0.03; 121 async {
122 print "@_\n";
123 } 1,2,3,4;
41 124
42 require XSLoader; 125The coderef you submit MUST NOT be a closure that refers to variables
43 XSLoader::load Coro, $VERSION; 126in an outer scope. This does NOT work. Pass arguments into it instead.
44}
45 127
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 128=cut
55 129
56$main = $current = _newprocess { 130sub async(&@) {
57 # never being called 131 my $pid = new Coro @_;
58}; 132 $pid->ready;
133 $pid;
134}
59 135
60=item $error, $error_msg, $error_coro 136=item schedule
61 137
62This coroutine will be called on fatal errors. C<$error_msg> and 138Calls the scheduler. Please note that the current process will not be put
63C<$error_coro> return the error message and the error-causing coroutine, 139into the ready queue, so calling this function usually means you will
64respectively. 140never be called again.
65 141
66=cut 142=cut
67 143
68$error_msg = 144my $prev;
69$error_coro = undef;
70 145
71$error = _newprocess { 146sub schedule {
72 print STDERR "FATAL: $error_msg\nprogram aborted\n"; 147 # should be done using priorities :(
73 exit 250; 148 ($prev, $current) = ($current, shift @ready || $idle);
74}; 149 Coro::State::transfer($prev, $current);
150}
75 151
76=item $coro = new $coderef [, @args] 152=item yield
77 153
78Create a new coroutine and return it. The first C<resume> call to this 154Yield to other processes. This function puts the current process into the
79coroutine will start execution at the given coderef. If it returns it 155ready queue and calls C<schedule>.
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 156
83=cut 157=cut
158
159sub yield {
160 $current->ready;
161 &schedule;
162}
163
164=item terminate
165
166Terminates the current process.
167
168Future versions of this function will allow result arguments.
169
170=cut
171
172sub terminate {
173 $current->{_results} = [@_];
174 &schedule;
175}
176
177=back
178
179# dynamic methods
180
181=head2 PROCESS METHODS
182
183These are the methods you can call on process objects.
184
185=over 4
186
187=item new Coro \&sub [, @args...]
188
189Create a new process and return it. When the sub returns the process
190automatically terminates. To start the process you must first put it into
191the ready queue by calling the ready method.
192
193The coderef you submit MUST NOT be a closure that refers to variables
194in an outer scope. This does NOT work. Pass arguments into it instead.
195
196=cut
197
198sub _newcoro {
199 terminate &{+shift};
200}
84 201
85sub new { 202sub new {
86 my $class = $_[0]; 203 my $class = shift;
87 my $proc = $_[1]; 204 bless {
88 bless _newprocess { 205 _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; 206 }, $class;
97} 207}
98 208
99=item $coro->resume 209=item $process->ready
100 210
101Resume execution at the given coroutine. 211Put the current process into the ready queue.
102 212
103=cut 213=cut
104 214
105my $prev; 215sub ready {
106 216 push @ready, $_[0];
107# I call the _transfer function from a pelr function
108# because that way perl saves all important things on
109# the stack.
110sub resume {
111 $prev = $current; $current = $_[0];
112 _transfer($prev, $current);
113} 217}
218
219=back
220
221=cut
114 222
1151; 2231;
116 224
117=back 225=head1 BUGS/LIMITATIONS
118 226
119=head1 BUGS 227 - could be faster, especially when the core would introduce special
120 228 support for coroutines (like it does for threads).
121This module has not yet been extensively tested. 229 - there is still a memleak on coroutine termination that I could not
230 identify. Could be as small as a single SV.
231 - this module is not well-tested.
232 - if variables or arguments "disappear" (become undef) or become
233 corrupted please contact the author so he cen iron out the
234 remaining bugs.
235 - this module is not thread-safe. You must only ever use this module from
236 the same thread (this requirement might be loosened in the future to
237 allow per-thread schedulers, but Coro::Satte does not yet allow this).
122 238
123=head1 SEE ALSO 239=head1 SEE ALSO
124 240
125L<Coro::Process>, L<Coro::Signal>. 241L<Coro::Channel>, L<Coro::Cont>, L<Coro::Specific>, L<Coro::Semaphore>,
242L<Coro::Signal>, L<Coro::State>, L<Coro::Event>.
126 243
127=head1 AUTHOR 244=head1 AUTHOR
128 245
129 Marc Lehmann <pcg@goof.com> 246 Marc Lehmann <pcg@goof.com>
130 http://www.goof.com/pcg/marc/ 247 http://www.goof.com/pcg/marc/

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines