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.6 by root, Tue Jul 10 21:19:47 2001 UTC

1=head1 NAME 1=head1 NAME
2 2
3Coro - create an manage coroutines 3Coro - create and manage simple coroutines
4 4
5=head1 SYNOPSIS 5=head1 SYNOPSIS
6 6
7 use Coro; 7 use Coro;
8 8
9 $new = new Coro sub {
10 print "in coroutine, switching back\n";
11 $new->transfer($main);
12 print "in coroutine again, switching back\n";
13 $new->transfer($main);
14 };
15
16 $main = new Coro;
17
18 print "in main, switching to coroutine\n";
19 $main->transfer($new);
20 print "back in main, switch to coroutine again\n";
21 $main->transfer($new);
22 print "back in main\n";
23
9=head1 DESCRIPTION 24=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.
10 34
11=over 4 35=over 4
12 36
13=cut 37=cut
14 38
15package Coro; 39package Coro;
16 40
17BEGIN { 41BEGIN {
18 $VERSION = 0.01; 42 $VERSION = 0.03;
19 43
20 require XSLoader; 44 require XSLoader;
21 XSLoader::load Coro, $VERSION; 45 XSLoader::load Coro, $VERSION;
22} 46}
23 47
24=item $main 48=item $coro = new [$coderef [, @args]]
25 49
26This coroutine represents the main program. 50Create a new coroutine and return it. The first C<transfer> call to this
51coroutine will start execution at the given coderef. If, the subroutine
52returns it will be executed again.
27 53
28=item $current 54If the coderef is omitted this function will create a new "empty"
29 55coroutine, i.e. a coroutine that cannot be transfered to but can be used
30The current coroutine (the last coroutine switched to). The initial value is C<$main> (of course). 56to save the current coroutine in.
31 57
32=cut 58=cut
33 59
34$main = $current = _newprocess { 60sub new {
35 # never being called 61 my $class = $_[0];
36}; 62 my $proc = $_[1] || sub { die "tried to transfer to an empty coroutine" };
63 bless _newprocess {
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;
73}
74
75=item $prev->transfer($next)
76
77Save the state of the current subroutine in $prev and switch to the
78coroutine saved in $next.
79
80=cut
81
82# I call the _transfer function from a perl function
83# because that way perl saves all important things on
84# the stack.
85sub transfer {
86 _transfer($_[0], $_[1]);
87}
37 88
38=item $error, $error_msg, $error_coro 89=item $error, $error_msg, $error_coro
39 90
40This coroutine will be called on fatal errors. C<$error_msg> and 91This coroutine will be called on fatal errors. C<$error_msg> and
41C<$error_coro> return the error message and the error-causing coroutine, 92C<$error_coro> return the error message and the error-causing coroutine
42respectively. 93(NOT an object) respectively. This API might change.
43 94
44=cut 95=cut
45 96
46$error_msg = 97$error_msg =
47$error_coro = undef; 98$error_coro = undef;
48 99
49$error = _newprocess { 100$error = _newprocess {
50 print STDERR "FATAL: $error_msg, program aborted\n"; 101 print STDERR "FATAL: $error_msg\nprogram aborted\n";
51 exit 250; 102 exit 50;
52}; 103};
53
54=item $coro = new $coderef [, @args]
55
56Create a new coroutine and return it. The first C<resume> call to this
57coroutine will start execution at the given coderef. If it returns it
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
61=cut
62
63sub new {
64 my $class = $_[0];
65 my $proc = $_[1];
66 bless _newprocess {
67 do {
68 eval { &$proc->resume };
69 if ($@) {
70 ($error_msg, $error_coro) = ($@, $current);
71 $error->resume;
72 }
73 } while ();
74 }, $class;
75}
76
77=item $coro->resume
78
79Resume execution at the given coroutine.
80
81=cut
82
83my $prev;
84
85sub resume {
86 $prev = $current; $current = $_[0];
87 _transfer($prev, $current);
88}
89 104
901; 1051;
91 106
92=back 107=back
93 108
94=head1 BUGS 109=head1 BUGS
95 110
96This module has not yet been extensively tested. 111This module has not yet been extensively tested.
97 112
113=head1 SEE ALSO
114
115L<Coro::Process>, L<Coro::Signal>.
116
98=head1 AUTHOR 117=head1 AUTHOR
99 118
100 Marc Lehmann <pcg@goof.com> 119 Marc Lehmann <pcg@goof.com>
101 http://www.goof.com/pcg/marc/ 120 http://www.goof.com/pcg/marc/
102 121

Diff Legend

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