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

Comparing Coro/Coro.pm (file contents):
Revision 1.7 by root, Fri Jul 13 13:05:38 2001 UTC vs.
Revision 1.8 by root, Sat Jul 14 22:14:21 2001 UTC

1=head1 NAME 1=head1 NAME
2 2
3Coro - create and manage simple coroutines 3Coro - coroutine process abstraction
4 4
5=head1 SYNOPSIS 5=head1 SYNOPSIS
6 6
7 use Coro; 7 use Coro;
8 8
9 $new = new Coro sub { 9 async {
10 print "in coroutine, switching back\n"; 10 # some asynchronous thread of execution
11 $new->transfer($main);
12 print "in coroutine again, switching back\n";
13 $new->transfer($main);
14 }; 11 };
15 12
16 $main = new Coro; 13 # alternatively create an async process like this:
17 14
18 print "in main, switching to coroutine\n"; 15 sub some_func : Coro {
19 $main->transfer($new); 16 # some more async code
20 print "back in main, switch to coroutine again\n"; 17 }
21 $main->transfer($new); 18
22 print "back in main\n"; 19 yield;
23 20
24=head1 DESCRIPTION 21=head1 DESCRIPTION
25
26This module implements coroutines. Coroutines, similar to continuations,
27allow you to run more than one "thread of execution" in parallel. Unlike
28threads this, only voluntary switching is used so locking problems are
29greatly reduced.
30
31Although this is the "main" module of the Coro family it provides only
32low-level functionality. See L<Coro::Process> and related modules for a
33more useful process abstraction including scheduling.
34
35=over 4
36 22
37=cut 23=cut
38 24
39package Coro; 25package Coro;
40 26
41BEGIN { 27use Coro::State;
42 $VERSION = 0.03;
43 28
44 require XSLoader; 29use base Exporter;
45 XSLoader::load Coro, $VERSION; 30
31$VERSION = 0.03;
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 }
46} 62}
47 63
48=item $coro = new [$coderef [, @args]] 64my $idle = new Coro sub {
65 &yield while 1;
66};
49 67
50Create a new coroutine and return it. The first C<transfer> call to this 68=item $main
51coroutine will start execution at the given coderef. If, the subroutine
52returns it will be executed again.
53 69
54If the coderef is omitted this function will create a new "empty" 70This coroutine represents the main program.
55coroutine, i.e. a coroutine that cannot be transfered to but can be used 71
56to save the current coroutine in. 72=cut
73
74$main = new Coro;
75
76=item $current
77
78The current coroutine (the last coroutine switched to). The initial value is C<$main> (of course).
79
80=cut
81
82# maybe some other module used Coro::Specific before...
83if ($current) {
84 $main->{specific} = $current->{specific};
85}
86
87$current = $main;
88
89# we really need priorities...
90my @ready = (); # the ready queue. hehe, rather broken ;)
91
92# static methods. not really.
93
94=head2 STATIC METHODS
95
96Static methods are actually functions that operate on the current process only.
97
98=over 4
99
100=item async { ... };
101
102Create a new asynchronous process and return it's process object
103(usually unused). When the sub returns the new process is automatically
104terminated.
105
106=cut
107
108sub async(&) {
109 (new Coro $_[0])->ready;
110}
111
112=item schedule
113
114Calls the scheduler. Please note that the current process will not be put
115into the ready queue, so calling this function usually means you will
116never be called again.
117
118=cut
119
120my $prev;
121
122sub schedule {
123 ($prev, $current) = ($current, shift @ready);
124 Coro::State::transfer($prev, $current);
125}
126
127=item yield
128
129Yield to other processes. This function puts the current process into the
130ready queue and calls C<schedule>.
131
132=cut
133
134sub yield {
135 $current->ready;
136 &schedule;
137}
138
139=item terminate
140
141Terminates the current process.
142
143=cut
144
145sub terminate {
146 &schedule;
147}
148
149=back
150
151# dynamic methods
152
153=head2 PROCESS METHODS
154
155These are the methods you can call on process objects.
156
157=over 4
158
159=item new Coro \&sub;
160
161Create a new process and return it. When the sub returns the process
162automatically terminates. To start the process you must first put it into
163the ready queue by calling the ready method.
57 164
58=cut 165=cut
59 166
60sub new { 167sub new {
168 my $class = shift;
61 my $class = $_[0]; 169 my $proc = $_[0];
62 my $proc = $_[1] || sub { die "tried to transfer to an empty coroutine" }; 170 bless {
63 bless _newprocess { 171 _coro_state => new Coro::State ($proc ? sub { &$proc; &terminate } : $proc),
64 do {
65 eval { &$proc };
66 if ($@) {
67 $error_msg = $@;
68 $error_coro = _newprocess { };
69 &transfer($error_coro, $error);
70 }
71 } while (1);
72 }, $class; 172 }, $class;
73} 173}
74 174
75=item $prev->transfer($next) 175=item $process->ready
76 176
77Save the state of the current subroutine in C<$prev> and switch to the 177Put the current process into the ready queue.
78coroutine saved in C<$next>.
79
80The "state" of a subroutine only ever includes scope, i.e. lexical
81variables and the current execution state. It does not save/restore any
82global variables such as C<$_> or C<$@> or any other special or non
83special variables. So remember that every function call that might call
84C<transfer> (such as C<Coro::Channel::put>) might clobber any global
85and/or special variables. Yes, this is by design ;) You cna always create
86your own process abstraction model that saves these variables.
87
88The easiest way to do this is to create your own scheduling primitive like this:
89
90 sub schedule {
91 local ($_, $@, ...);
92 $old->transfer($new);
93 }
94 178
95=cut 179=cut
96 180
97# I call the _transfer function from a perl function 181sub ready {
98# because that way perl saves all important things on 182 push @ready, $_[0];
99# the stack. Actually, I'd do it from within XS, but
100# I couldn't get it to work.
101sub transfer {
102 _transfer($_[0], $_[1]);
103} 183}
104 184
105=item $error, $error_msg, $error_coro 185=back
106
107This coroutine will be called on fatal errors. C<$error_msg> and
108C<$error_coro> return the error message and the error-causing coroutine
109(NOT an object) respectively. This API might change.
110 186
111=cut 187=cut
112 188
113$error_msg =
114$error_coro = undef;
115
116$error = _newprocess {
117 print STDERR "FATAL: $error_msg\nprogram aborted\n";
118 exit 50;
119};
120
1211; 1891;
122
123=back
124
125=head1 BUGS
126
127This module has not yet been extensively tested.
128
129=head1 SEE ALSO
130
131L<Coro::Process>, L<Coro::Signal>.
132 190
133=head1 AUTHOR 191=head1 AUTHOR
134 192
135 Marc Lehmann <pcg@goof.com> 193 Marc Lehmann <pcg@goof.com>
136 http://www.goof.com/pcg/marc/ 194 http://www.goof.com/pcg/marc/

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines