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

Comparing Coro/Coro.pm (file contents):
Revision 1.1 by root, Tue Jul 3 02:53:34 2001 UTC vs.
Revision 1.14 by root, Tue Jul 17 02:21:56 2001 UTC

1=head1 NAME 1=head1 NAME
2 2
3Coro - create an 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 async {
10 # some asynchronous thread of execution
11 };
12
13 # alternatively create an async process like this:
14
15 sub some_func : Coro {
16 # some more async code
17 }
18
19 yield;
20
9=head1 DESCRIPTION 21=head1 DESCRIPTION
10 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
28=cut
29
30package Coro;
31
32use Coro::State;
33
34use base Exporter;
35
36$VERSION = 0.05;
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, $name, @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...
104## my @ready; #d#
105our @ready = (); # the ready queue. hehe, rather broken ;)
106
107# static methods. not really.
108
109=head2 STATIC METHODS
110
111Static methods are actually functions that operate on the current process only.
112
11=over 4 113=over 4
12 114
13=cut 115=item async { ... } [@args...]
14 116
15package Coro; 117Create a new asynchronous process and return it's process object
118(usually unused). When the sub returns the new process is automatically
119terminated.
16 120
17BEGIN { 121 # create a new coroutine that just prints its arguments
18 $VERSION = 0.01; 122 async {
123 print "@_\n";
124 } 1,2,3,4;
19 125
20 require XSLoader; 126The coderef you submit MUST NOT be a closure that refers to variables
21 XSLoader::load Coro, $VERSION; 127in an outer scope. This does NOT work. Pass arguments into it instead.
22}
23 128
24=item $main
25
26This coroutine represents the main program.
27
28=item $current
29
30The current coroutine (the last coroutine switched to). The initial value is C<$main> (of course).
31
32=cut 129=cut
33 130
34$main = $current = _newprocess { 131sub async(&@) {
35 # never being called 132 my $pid = new Coro @_;
36}; 133 $pid->ready;
134 $pid;
135}
37 136
38=item $error, $error_msg, $error_coro 137=item schedule
39 138
40This coroutine will be called on fatal errors. C<$error_msg> and 139Calls the scheduler. Please note that the current process will not be put
41C<$error_coro> return the error message and the error-causing coroutine, 140into the ready queue, so calling this function usually means you will
42respectively. 141never be called again.
43 142
44=cut 143=cut
45 144
46$error_msg = 145my $prev;
47$error_coro = undef;
48 146
49$error = _newprocess { 147sub schedule {
50 print STDERR "FATAL: $error_msg, program aborted\n"; 148 # should be done using priorities :(
51 exit 250; 149 ($prev, $current) = ($current, shift @ready || $idle);
52}; 150 Coro::State::transfer($prev, $current);
151}
53 152
54=item $coro = new $coderef [, @args] 153=item yield
55 154
56Create a new coroutine and return it. The first C<resume> call to this 155Yield to other processes. This function puts the current process into the
57coroutine will start execution at the given coderef. If it returns it 156ready queue and calls C<schedule>.
58should return a coroutine to switch to. If, after returning, the coroutine
59is C<resume>d again it starts execution again at the givne coderef.
60 157
61=cut 158=cut
159
160sub yield {
161 $current->ready;
162 &schedule;
163}
164
165=item terminate
166
167Terminates the current process.
168
169Future versions of this function will allow result arguments.
170
171=cut
172
173sub terminate {
174 $current->{_results} = [@_];
175 &schedule;
176}
177
178=back
179
180# dynamic methods
181
182=head2 PROCESS METHODS
183
184These are the methods you can call on process objects.
185
186=over 4
187
188=item new Coro \&sub [, @args...]
189
190Create a new process and return it. When the sub returns the process
191automatically terminates. To start the process you must first put it into
192the ready queue by calling the ready method.
193
194The coderef you submit MUST NOT be a closure that refers to variables
195in an outer scope. This does NOT work. Pass arguments into it instead.
196
197=cut
198
199sub _newcoro {
200 terminate &{+shift};
201}
62 202
63sub new { 203sub new {
64 my $class = $_[0]; 204 my $class = shift;
65 my $proc = $_[1]; 205 bless {
66 bless _newprocess { 206 _coro_state => (new Coro::State $_[0] && \&_newcoro, @_),
67 do {
68 eval { &$proc->resume };
69 if ($@) {
70 ($error_msg, $error_coro) = ($@, $current);
71 $error->resume;
72 }
73 } while ();
74 }, $class; 207 }, $class;
75} 208}
76 209
77=item $coro->resume 210=item $process->ready
78 211
79Resume execution at the given coroutine. 212Put the current process into the ready queue.
80 213
81=cut 214=cut
82 215
83my $prev; 216sub ready {
84 217 push @ready, $_[0];
85sub resume {
86 $prev = $current; $current = $_[0];
87 _transfer($prev, $current);
88} 218}
219
220=back
221
222=cut
89 223
901; 2241;
91 225
92=back
93
94=head1 BUGS 226=head1 BUGS
95 227
96This module has not yet been extensively tested. 228 - could be faster, especially when the core would introduce special
229 support for coroutines (like it does for threads).
230 - there is still a memleak on coroutine termination that I could not
231 identify. Could be as small as a single SV.
232 - this module is not well-tested.
233
234=head1 SEE ALSO
235
236L<Coro::Channel>, L<Coro::Cont>, L<Coro::Specific>, L<Coro::Semaphore>,
237L<Coro::Signal>, L<Coro::State>, L<Coro::Event>.
97 238
98=head1 AUTHOR 239=head1 AUTHOR
99 240
100 Marc Lehmann <pcg@goof.com> 241 Marc Lehmann <pcg@goof.com>
101 http://www.goof.com/pcg/marc/ 242 http://www.goof.com/pcg/marc/

Diff Legend

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