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.9 by root, Sun Jul 15 02:35:52 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
23=cut
24
25package Coro;
26
27use Coro::State;
28
29use base Exporter;
30
31$VERSION = 0.04;
32
33@EXPORT = qw(async yield schedule);
34@EXPORT_OK = qw($current);
35
36{
37 use subs 'async';
38
39 my @async;
40
41 # this way of handling attributes simply is NOT scalable ;()
42 sub import {
43 Coro->export_to_level(1, @_);
44 my $old = *{(caller)[0]."::MODIFY_CODE_ATTRIBUTES"}{CODE};
45 *{(caller)[0]."::MODIFY_CODE_ATTRIBUTES"} = sub {
46 my ($package, $ref) = (shift, shift);
47 my @attrs;
48 for (@_) {
49 if ($_ eq "Coro") {
50 push @async, $ref;
51 } else {
52 push @attrs, @_;
53 }
54 }
55 return $old ? $old->($package, $name, @attrs) : @attrs;
56 };
57 }
58
59 sub INIT {
60 async pop @async while @async;
61 }
62}
63
64=item $main
65
66This coroutine represents the main program.
67
68=cut
69
70our $main = new Coro;
71
72=item $current
73
74The current coroutine (the last coroutine switched to). The initial value is C<$main> (of course).
75
76=cut
77
78# maybe some other module used Coro::Specific before...
79if ($current) {
80 $main->{specific} = $current->{specific};
81}
82
83our $current = $main;
84
85=item $idle
86
87The coroutine to switch to when no other coroutine is running. The default
88implementation prints "FATAL: deadlock detected" and exits.
89
90=cut
91
92# should be done using priorities :(
93our $idle = new Coro sub {
94 print STDERR "FATAL: deadlock detected\n";
95 exit(51);
96};
97
98# we really need priorities...
99my @ready = (); # the ready queue. hehe, rather broken ;)
100
101# static methods. not really.
102
103=head2 STATIC METHODS
104
105Static methods are actually functions that operate on the current process only.
106
11=over 4 107=over 4
12 108
13=cut 109=item async { ... };
14 110
15package Coro; 111Create a new asynchronous process and return it's process object
112(usually unused). When the sub returns the new process is automatically
113terminated.
16 114
17BEGIN {
18 $VERSION = 0.01;
19
20 require XSLoader;
21 XSLoader::load Coro, $VERSION;
22}
23
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 115=cut
33 116
34$main = $current = _newprocess { 117sub async(&) {
35 # never being called 118 (new Coro $_[0])->ready;
36}; 119}
37 120
38=item $error, $error_msg, $error_coro 121=item schedule
39 122
40This coroutine will be called on fatal errors. C<$error_msg> and 123Calls the scheduler. Please note that the current process will not be put
41C<$error_coro> return the error message and the error-causing coroutine, 124into the ready queue, so calling this function usually means you will
42respectively. 125never be called again.
43 126
44=cut 127=cut
45 128
46$error_msg = 129my $prev;
47$error_coro = undef;
48 130
49$error = _newprocess { 131sub schedule {
50 print STDERR "FATAL: $error_msg, program aborted\n"; 132 # should be done using priorities :(
51 exit 250; 133 ($prev, $current) = ($current, shift @ready || $idle);
52}; 134 Coro::State::transfer($prev, $current);
135}
53 136
54=item $coro = new $coderef [, @args] 137=item yield
55 138
56Create a new coroutine and return it. The first C<resume> call to this 139Yield to other processes. This function puts the current process into the
57coroutine will start execution at the given coderef. If it returns it 140ready queue and calls C<schedule>.
58should return a coroutine to switch to. If, after returning, the coroutine 141
59is C<resume>d again it starts execution again at the givne coderef. 142=cut
143
144sub yield {
145 $current->ready;
146 &schedule;
147}
148
149=item terminate
150
151Terminates the current process.
152
153=cut
154
155sub terminate {
156 &schedule;
157}
158
159=back
160
161# dynamic methods
162
163=head2 PROCESS METHODS
164
165These are the methods you can call on process objects.
166
167=over 4
168
169=item new Coro \&sub;
170
171Create a new process and return it. When the sub returns the process
172automatically terminates. To start the process you must first put it into
173the ready queue by calling the ready method.
60 174
61=cut 175=cut
62 176
63sub new { 177sub new {
64 my $class = $_[0]; 178 my $class = shift;
65 my $proc = $_[1]; 179 my $proc = $_[0];
66 bless _newprocess { 180 bless {
67 do { 181 _coro_state => new Coro::State ($proc ? sub { &$proc; &terminate } : $proc),
68 eval { &$proc->resume };
69 if ($@) {
70 ($error_msg, $error_coro) = ($@, $current);
71 $error->resume;
72 }
73 } while ();
74 }, $class; 182 }, $class;
75} 183}
76 184
77=item $coro->resume 185=item $process->ready
78 186
79Resume execution at the given coroutine. 187Put the current process into the ready queue.
80 188
81=cut 189=cut
82 190
83my $prev; 191sub ready {
84 192 push @ready, $_[0];
85sub resume {
86 $prev = $current; $current = $_[0];
87 _transfer($prev, $current);
88} 193}
194
195=back
196
197=cut
89 198
901; 1991;
91 200
92=back 201=head1 SEE ALSO
93 202
94=head1 BUGS 203L<Coro::Channel>, L<Coro::Cont>, L<Coro::Specific>, L<Coro::Semaphore>,
95 204L<Coro::Signal>, L<Coro::State>.
96This module has not yet been extensively tested.
97 205
98=head1 AUTHOR 206=head1 AUTHOR
99 207
100 Marc Lehmann <pcg@goof.com> 208 Marc Lehmann <pcg@goof.com>
101 http://www.goof.com/pcg/marc/ 209 http://www.goof.com/pcg/marc/

Diff Legend

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