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.22 by root, Mon Jul 23 02:14:19 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), that is, a coroutine has it's own callchain, it's
30own set of lexicals and it's own set of perl's most important global
31variables.
32
33WARNING: When using this module, make sure that, at program end, no
34coroutines are still running OR just call exit before falling off the
35end. The reason for this is that some coroutine of yours might have called
36into a C function, and falling off the end of main:: results in returning
37to that C function instead if to the main C interpreter.
38
39WARNING: Unless you really know what you are doing, do NOT do context
40switches inside callbacks from the XS level. The reason for this is
41similar to the reason above: A callback calls a perl function, this
42perl function does a context switch, some other callback is called, the
43original function returns from it - to what? To the wrong XS function,
44with totally different return values. Unfortunately, this includes
45callbacks done by perl itself (tie'd variables!).
46
47The only workaround for this is to do coroutines on C level.
48
49=cut
50
51package Coro;
52
53use Coro::State;
54
55use base Exporter;
56
57$VERSION = 0.10;
58
59@EXPORT = qw(async cede schedule terminate current);
60@EXPORT_OK = qw($current);
61
62{
63 my @async;
64
65 # this way of handling attributes simply is NOT scalable ;()
66 sub import {
67 Coro->export_to_level(1, @_);
68 my $old = *{(caller)[0]."::MODIFY_CODE_ATTRIBUTES"}{CODE};
69 *{(caller)[0]."::MODIFY_CODE_ATTRIBUTES"} = sub {
70 my ($package, $ref) = (shift, shift);
71 my @attrs;
72 for (@_) {
73 if ($_ eq "Coro") {
74 push @async, $ref;
75 } else {
76 push @attrs, $_;
77 }
78 }
79 return $old ? $old->($package, $ref, @attrs) : @attrs;
80 };
81 }
82
83 sub INIT {
84 &async(pop @async) while @async;
85 }
86}
87
88=item $main
89
90This coroutine represents the main program.
91
92=cut
93
94our $main = new Coro;
95
96=item $current (or as function: current)
97
98The current coroutine (the last coroutine switched to). The initial value is C<$main> (of course).
99
100=cut
101
102# maybe some other module used Coro::Specific before...
103if ($current) {
104 $main->{specific} = $current->{specific};
105}
106
107our $current = $main;
108
109sub current() { $current }
110
111=item $idle
112
113The coroutine to switch to when no other coroutine is running. The default
114implementation prints "FATAL: deadlock detected" and exits.
115
116=cut
117
118# should be done using priorities :(
119our $idle = new Coro sub {
120 print STDERR "FATAL: deadlock detected\n";
121 exit(51);
122};
123
124# we really need priorities...
125my @ready; # the ready queue. hehe, rather broken ;)
126
127# static methods. not really.
128
129=head2 STATIC METHODS
130
131Static methods are actually functions that operate on the current process only.
32 132
33=over 4 133=over 4
34 134
35=cut 135=item async { ... } [@args...]
36 136
37package Coro; 137Create a new asynchronous process and return it's process object
138(usually unused). When the sub returns the new process is automatically
139terminated.
38 140
39BEGIN { 141 # create a new coroutine that just prints its arguments
40 $VERSION = 0.01; 142 async {
143 print "@_\n";
144 } 1,2,3,4;
41 145
42 require XSLoader; 146The coderef you submit MUST NOT be a closure that refers to variables
43 XSLoader::load Coro, $VERSION; 147in an outer scope. This does NOT work. Pass arguments into it instead.
44}
45 148
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 149=cut
55 150
56$main = $current = _newprocess { 151sub async(&@) {
57 # never being called 152 my $pid = new Coro @_;
58}; 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 = 165my $prev;
69$error_coro = undef;
70 166
71$error = _newprocess { 167sub schedule {
72 print STDERR "FATAL: $error_msg\nprogram aborted\n"; 168 # should be done using priorities :(
73 exit 250; 169 ($prev, $current) = ($current, shift @ready || $idle);
74}; 170 Coro::State::transfer($prev, $current);
171}
75 172
76=item $coro = new $coderef [, @args] 173=item cede
77 174
78Create a new coroutine and return it. The first C<resume> call to this 175"Cede" to other processes. This function puts the current process into the
79coroutine will start execution at the given coderef. If it returns it 176ready queue and calls C<schedule>, which has the effect of giving up the
80should return a coroutine to switch to. If, after returning, the coroutine 177current "timeslice" to other coroutines of the same or higher priority.
81is C<resume>d again it starts execution again at the givne coderef.
82 178
83=cut 179=cut
180
181sub cede {
182 $current->ready;
183 &schedule;
184}
185
186=item terminate
187
188Terminates the current process.
189
190Future versions of this function will allow result arguments.
191
192=cut
193
194sub terminate {
195 my $self = $current;
196 $self->{_results} = [@_];
197 $current = shift @ready || $idle;
198 Coro::State::transfer(delete $self->{_coro_state}, $current);
199 # cannot return
200 die;
201}
202
203=back
204
205# dynamic methods
206
207=head2 PROCESS METHODS
208
209These are the methods you can call on process objects.
210
211=over 4
212
213=item new Coro \&sub [, @args...]
214
215Create a new process and return it. When the sub returns the process
216automatically terminates. To start the process you must first put it into
217the ready queue by calling the ready method.
218
219The coderef you submit MUST NOT be a closure that refers to variables
220in an outer scope. This does NOT work. Pass arguments into it instead.
221
222=cut
223
224sub _newcoro {
225 terminate &{+shift};
226}
84 227
85sub new { 228sub new {
86 my $class = $_[0]; 229 my $class = shift;
87 my $proc = $_[1]; 230 bless {
88 bless _newprocess { 231 _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; 232 }, $class;
97} 233}
98 234
99=item $coro->resume 235=item $process->ready
100 236
101Resume execution at the given coroutine. 237Put the current process into the ready queue.
102 238
103=cut 239=cut
104 240
105my $prev; 241sub ready {
106 242 push @ready, $_[0];
107sub resume {
108 $prev = $current; $current = $_[0];
109 _transfer($prev, $current);
110} 243}
244
245=back
246
247=cut
111 248
1121; 2491;
113 250
114=back 251=head1 BUGS/LIMITATIONS
115 252
116=head1 BUGS 253 - could be faster, especially when the core would introduce special
117 254 support for coroutines (like it does for threads).
118This module has not yet been extensively tested. 255 - there is still a memleak on coroutine termination that I could not
256 identify. Could be as small as a single SV.
257 - this module is not well-tested.
258 - if variables or arguments "disappear" (become undef) or become
259 corrupted please contact the author so he cen iron out the
260 remaining bugs.
261 - this module is not thread-safe. You must only ever use this module from
262 the same thread (this requirement might be loosened in the future to
263 allow per-thread schedulers, but Coro::State does not yet allow this).
119 264
120=head1 SEE ALSO 265=head1 SEE ALSO
121 266
122L<Coro::Process>, L<Coro::Signal>. 267L<Coro::Channel>, L<Coro::Cont>, L<Coro::Specific>, L<Coro::Semaphore>,
268L<Coro::Signal>, L<Coro::State>, L<Coro::Event>.
123 269
124=head1 AUTHOR 270=head1 AUTHOR
125 271
126 Marc Lehmann <pcg@goof.com> 272 Marc Lehmann <pcg@goof.com>
127 http://www.goof.com/pcg/marc/ 273 http://www.goof.com/pcg/marc/

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines