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.11 by root, Sun Jul 15 03:24:18 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 my $pid = new Coro $_[0];
36}; 119 $pid->ready;
120 $pid;
121}
37 122
38=item $error, $error_msg, $error_coro 123=item schedule
39 124
40This coroutine will be called on fatal errors. C<$error_msg> and 125Calls the scheduler. Please note that the current process will not be put
41C<$error_coro> return the error message and the error-causing coroutine, 126into the ready queue, so calling this function usually means you will
42respectively. 127never be called again.
43 128
44=cut 129=cut
45 130
46$error_msg = 131my $prev;
47$error_coro = undef;
48 132
49$error = _newprocess { 133sub schedule {
50 print STDERR "FATAL: $error_msg, program aborted\n"; 134 # should be done using priorities :(
51 exit 250; 135 ($prev, $current) = ($current, shift @ready || $idle);
52}; 136 Coro::State::transfer($prev, $current);
137}
53 138
54=item $coro = new $coderef [, @args] 139=item yield
55 140
56Create a new coroutine and return it. The first C<resume> call to this 141Yield to other processes. This function puts the current process into the
57coroutine will start execution at the given coderef. If it returns it 142ready queue and calls C<schedule>.
58should return a coroutine to switch to. If, after returning, the coroutine 143
59is C<resume>d again it starts execution again at the givne coderef. 144=cut
145
146sub yield {
147 $current->ready;
148 &schedule;
149}
150
151=item terminate
152
153Terminates the current process.
154
155=cut
156
157sub terminate {
158 &schedule;
159}
160
161=back
162
163# dynamic methods
164
165=head2 PROCESS METHODS
166
167These are the methods you can call on process objects.
168
169=over 4
170
171=item new Coro \&sub;
172
173Create a new process and return it. When the sub returns the process
174automatically terminates. To start the process you must first put it into
175the ready queue by calling the ready method.
60 176
61=cut 177=cut
62 178
63sub new { 179sub new {
64 my $class = $_[0]; 180 my $class = shift;
65 my $proc = $_[1]; 181 my $proc = $_[0];
66 bless _newprocess { 182 bless {
67 do { 183 _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; 184 }, $class;
75} 185}
76 186
77=item $coro->resume 187=item $process->ready
78 188
79Resume execution at the given coroutine. 189Put the current process into the ready queue.
80 190
81=cut 191=cut
82 192
83my $prev; 193sub ready {
84 194 push @ready, $_[0];
85sub resume {
86 $prev = $current; $current = $_[0];
87 _transfer($prev, $current);
88} 195}
196
197=back
198
199=cut
89 200
901; 2011;
91 202
92=back 203=head1 SEE ALSO
93 204
94=head1 BUGS 205L<Coro::Channel>, L<Coro::Cont>, L<Coro::Specific>, L<Coro::Semaphore>,
95 206L<Coro::Signal>, L<Coro::State>, L<Coro::Event>.
96This module has not yet been extensively tested.
97 207
98=head1 AUTHOR 208=head1 AUTHOR
99 209
100 Marc Lehmann <pcg@goof.com> 210 Marc Lehmann <pcg@goof.com>
101 http://www.goof.com/pcg/marc/ 211 http://www.goof.com/pcg/marc/

Diff Legend

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