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.12 by root, Sun Jul 15 15:58:16 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.05;
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 local @_;
51 exit 250; 135 # should be done using priorities :(
52}; 136 ($prev, $current) = ($current, shift @ready || $idle);
137 Coro::State::transfer($prev, $current);
138}
53 139
54=item $coro = new $coderef [, @args] 140=item yield
55 141
56Create a new coroutine and return it. The first C<resume> call to this 142Yield to other processes. This function puts the current process into the
57coroutine will start execution at the given coderef. If it returns it 143ready queue and calls C<schedule>.
58should return a coroutine to switch to. If, after returning, the coroutine 144
59is C<resume>d again it starts execution again at the givne coderef. 145=cut
146
147sub yield {
148 $current->ready;
149 &schedule;
150}
151
152=item terminate
153
154Terminates the current process.
155
156=cut
157
158sub terminate {
159 &schedule;
160}
161
162=back
163
164# dynamic methods
165
166=head2 PROCESS METHODS
167
168These are the methods you can call on process objects.
169
170=over 4
171
172=item new Coro \&sub;
173
174Create a new process and return it. When the sub returns the process
175automatically terminates. To start the process you must first put it into
176the ready queue by calling the ready method.
60 177
61=cut 178=cut
62 179
63sub new { 180sub new {
64 my $class = $_[0]; 181 my $class = shift;
65 my $proc = $_[1]; 182 my $proc = $_[0];
66 bless _newprocess { 183 bless {
67 do { 184 _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; 185 }, $class;
75} 186}
76 187
77=item $coro->resume 188=item $process->ready
78 189
79Resume execution at the given coroutine. 190Put the current process into the ready queue.
80 191
81=cut 192=cut
82 193
83my $prev; 194sub ready {
84 195 push @ready, $_[0];
85sub resume {
86 $prev = $current; $current = $_[0];
87 _transfer($prev, $current);
88} 196}
197
198=back
199
200=cut
89 201
901; 2021;
91 203
92=back 204=head1 SEE ALSO
93 205
94=head1 BUGS 206L<Coro::Channel>, L<Coro::Cont>, L<Coro::Specific>, L<Coro::Semaphore>,
95 207L<Coro::Signal>, L<Coro::State>, L<Coro::Event>.
96This module has not yet been extensively tested.
97 208
98=head1 AUTHOR 209=head1 AUTHOR
99 210
100 Marc Lehmann <pcg@goof.com> 211 Marc Lehmann <pcg@goof.com>
101 http://www.goof.com/pcg/marc/ 212 http://www.goof.com/pcg/marc/

Diff Legend

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