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

Comparing Coro/Coro.pm (file contents):
Revision 1.8 by root, Sat Jul 14 22:14:21 2001 UTC vs.
Revision 1.20 by root, Sat Jul 21 18:21:45 2001 UTC

… …
18 18
19 yield; 19 yield;
20 20
21=head1 DESCRIPTION 21=head1 DESCRIPTION
22 22
23This module collection manages coroutines. Coroutines are similar to
24Threads but don't run in parallel.
25
26This module is still experimental, see the BUGS section below.
27
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
23=cut 33=cut
24 34
25package Coro; 35package Coro;
26 36
27use Coro::State; 37use Coro::State;
28 38
29use base Exporter; 39use base Exporter;
30 40
31$VERSION = 0.03; 41$VERSION = 0.10;
32 42
33@EXPORT = qw(async yield schedule); 43@EXPORT = qw(async yield schedule terminate current);
34@EXPORT_OK = qw($current); 44@EXPORT_OK = qw($current);
35 45
36{ 46{
37 use subs 'async';
38
39 my @async; 47 my @async;
40 48
41 # this way of handling attributes simply is NOT scalable ;() 49 # this way of handling attributes simply is NOT scalable ;()
42 sub import { 50 sub import {
43 Coro->export_to_level(1, @_); 51 Coro->export_to_level(1, @_);
… …
47 my @attrs; 55 my @attrs;
48 for (@_) { 56 for (@_) {
49 if ($_ eq "Coro") { 57 if ($_ eq "Coro") {
50 push @async, $ref; 58 push @async, $ref;
51 } else { 59 } else {
52 push @attrs, @_; 60 push @attrs, $_;
53 } 61 }
54 } 62 }
55 return $old ? $old->($package, $name, @attrs) : @attrs; 63 return $old ? $old->($package, $ref, @attrs) : @attrs;
56 }; 64 };
57 } 65 }
58 66
59 sub INIT { 67 sub INIT {
60 async pop @async while @async; 68 &async(pop @async) while @async;
61 } 69 }
62} 70}
63 71
64my $idle = new Coro sub {
65 &yield while 1;
66};
67
68=item $main 72=item $main
69 73
70This coroutine represents the main program. 74This coroutine represents the main program.
71 75
72=cut 76=cut
73 77
74$main = new Coro; 78our $main = new Coro;
75 79
76=item $current 80=item $current (or as function: current)
77 81
78The current coroutine (the last coroutine switched to). The initial value is C<$main> (of course). 82The current coroutine (the last coroutine switched to). The initial value is C<$main> (of course).
79 83
80=cut 84=cut
81 85
82# maybe some other module used Coro::Specific before... 86# maybe some other module used Coro::Specific before...
83if ($current) { 87if ($current) {
84 $main->{specific} = $current->{specific}; 88 $main->{specific} = $current->{specific};
85} 89}
86 90
87$current = $main; 91our $current = $main;
92
93sub current() { $current }
94
95=item $idle
96
97The coroutine to switch to when no other coroutine is running. The default
98implementation prints "FATAL: deadlock detected" and exits.
99
100=cut
101
102# should be done using priorities :(
103our $idle = new Coro sub {
104 print STDERR "FATAL: deadlock detected\n";
105 exit(51);
106};
88 107
89# we really need priorities... 108# we really need priorities...
90my @ready = (); # the ready queue. hehe, rather broken ;) 109my @ready; # the ready queue. hehe, rather broken ;)
91 110
92# static methods. not really. 111# static methods. not really.
93 112
94=head2 STATIC METHODS 113=head2 STATIC METHODS
95 114
96Static methods are actually functions that operate on the current process only. 115Static methods are actually functions that operate on the current process only.
97 116
98=over 4 117=over 4
99 118
100=item async { ... }; 119=item async { ... } [@args...]
101 120
102Create a new asynchronous process and return it's process object 121Create a new asynchronous process and return it's process object
103(usually unused). When the sub returns the new process is automatically 122(usually unused). When the sub returns the new process is automatically
104terminated. 123terminated.
105 124
106=cut 125 # create a new coroutine that just prints its arguments
126 async {
127 print "@_\n";
128 } 1,2,3,4;
107 129
130The coderef you submit MUST NOT be a closure that refers to variables
131in an outer scope. This does NOT work. Pass arguments into it instead.
132
133=cut
134
108sub async(&) { 135sub async(&@) {
109 (new Coro $_[0])->ready; 136 my $pid = new Coro @_;
137 $pid->ready;
138 $pid;
110} 139}
111 140
112=item schedule 141=item schedule
113 142
114Calls the scheduler. Please note that the current process will not be put 143Calls the scheduler. Please note that the current process will not be put
… …
118=cut 147=cut
119 148
120my $prev; 149my $prev;
121 150
122sub schedule { 151sub schedule {
152 # should be done using priorities :(
123 ($prev, $current) = ($current, shift @ready); 153 ($prev, $current) = ($current, shift @ready || $idle);
124 Coro::State::transfer($prev, $current); 154 Coro::State::transfer($prev, $current);
125} 155}
126 156
127=item yield 157=item yield
128 158
… …
138 168
139=item terminate 169=item terminate
140 170
141Terminates the current process. 171Terminates the current process.
142 172
173Future versions of this function will allow result arguments.
174
143=cut 175=cut
144 176
145sub terminate { 177sub terminate {
178 $current->{_results} = [@_];
146 &schedule; 179 &schedule;
147} 180}
148 181
149=back 182=back
150 183
… …
154 187
155These are the methods you can call on process objects. 188These are the methods you can call on process objects.
156 189
157=over 4 190=over 4
158 191
159=item new Coro \&sub; 192=item new Coro \&sub [, @args...]
160 193
161Create a new process and return it. When the sub returns the process 194Create a new process and return it. When the sub returns the process
162automatically terminates. To start the process you must first put it into 195automatically terminates. To start the process you must first put it into
163the ready queue by calling the ready method. 196the ready queue by calling the ready method.
164 197
198The coderef you submit MUST NOT be a closure that refers to variables
199in an outer scope. This does NOT work. Pass arguments into it instead.
200
165=cut 201=cut
202
203sub _newcoro {
204 terminate &{+shift};
205}
166 206
167sub new { 207sub new {
168 my $class = shift; 208 my $class = shift;
169 my $proc = $_[0];
170 bless { 209 bless {
171 _coro_state => new Coro::State ($proc ? sub { &$proc; &terminate } : $proc), 210 _coro_state => (new Coro::State $_[0] && \&_newcoro, @_),
172 }, $class; 211 }, $class;
173} 212}
174 213
175=item $process->ready 214=item $process->ready
176 215
… …
186 225
187=cut 226=cut
188 227
1891; 2281;
190 229
230=head1 BUGS/LIMITATIONS
231
232 - could be faster, especially when the core would introduce special
233 support for coroutines (like it does for threads).
234 - there is still a memleak on coroutine termination that I could not
235 identify. Could be as small as a single SV.
236 - this module is not well-tested.
237 - if variables or arguments "disappear" (become undef) or become
238 corrupted please contact the author so he cen iron out the
239 remaining bugs.
240 - this module is not thread-safe. You must only ever use this module from
241 the same thread (this requirement might be loosened in the future to
242 allow per-thread schedulers, but Coro::State does not yet allow this).
243
244=head1 SEE ALSO
245
246L<Coro::Channel>, L<Coro::Cont>, L<Coro::Specific>, L<Coro::Semaphore>,
247L<Coro::Signal>, L<Coro::State>, L<Coro::Event>.
248
191=head1 AUTHOR 249=head1 AUTHOR
192 250
193 Marc Lehmann <pcg@goof.com> 251 Marc Lehmann <pcg@goof.com>
194 http://www.goof.com/pcg/marc/ 252 http://www.goof.com/pcg/marc/
195 253

Diff Legend

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