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

Comparing Coro/Coro.pm (file contents):
Revision 1.5 by root, Tue Jul 10 01:43:21 2001 UTC vs.
Revision 1.7 by root, Fri Jul 13 13:05:38 2001 UTC

1=head1 NAME 1=head1 NAME
2 2
3Coro - create and 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 { 9 $new = new Coro sub {
10 print "in coroutine, switching back\n"; 10 print "in coroutine, switching back\n";
11 $Coro::main->resume; 11 $new->transfer($main);
12 print "in coroutine again, switching back\n"; 12 print "in coroutine again, switching back\n";
13 $Coro::main->resume; 13 $new->transfer($main);
14 }; 14 };
15 15
16 $main = new Coro;
17
16 print "in main, switching to coroutine\n"; 18 print "in main, switching to coroutine\n";
17 $new->resume; 19 $main->transfer($new);
18 print "back in main, switch to coroutine again\n"; 20 print "back in main, switch to coroutine again\n";
19 $new->resume; 21 $main->transfer($new);
20 print "back in main\n"; 22 print "back in main\n";
21 23
22=head1 DESCRIPTION 24=head1 DESCRIPTION
23 25
24This module implements coroutines. Coroutines, similar to continuations, 26This module implements coroutines. Coroutines, similar to continuations,
… …
41 43
42 require XSLoader; 44 require XSLoader;
43 XSLoader::load Coro, $VERSION; 45 XSLoader::load Coro, $VERSION;
44} 46}
45 47
46=item $main 48=item $coro = new [$coderef [, @args]]
47 49
48This 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.
49 53
50=item $current 54If the coderef is omitted this function will create a new "empty"
51 55coroutine, i.e. a coroutine that cannot be transfered to but can be used
52The current coroutine (the last coroutine switched to). The initial value is C<$main> (of course). 56to save the current coroutine in.
53 57
54=cut 58=cut
55 59
56$main = $current = _newprocess { 60sub new {
57 # never being called 61 my $class = $_[0];
58}; 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 C<$prev> and switch to the
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
95=cut
96
97# I call the _transfer function from a perl function
98# because that way perl saves all important things on
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}
59 104
60=item $error, $error_msg, $error_coro 105=item $error, $error_msg, $error_coro
61 106
62This coroutine will be called on fatal errors. C<$error_msg> and 107This coroutine will be called on fatal errors. C<$error_msg> and
63C<$error_coro> return the error message and the error-causing coroutine, 108C<$error_coro> return the error message and the error-causing coroutine
64respectively. 109(NOT an object) respectively. This API might change.
65 110
66=cut 111=cut
67 112
68$error_msg = 113$error_msg =
69$error_coro = undef; 114$error_coro = undef;
70 115
71$error = _newprocess { 116$error = _newprocess {
72 print STDERR "FATAL: $error_msg\nprogram aborted\n"; 117 print STDERR "FATAL: $error_msg\nprogram aborted\n";
73 exit 250; 118 exit 50;
74}; 119};
75
76=item $coro = new $coderef [, @args]
77
78Create a new coroutine and return it. The first C<resume> call to this
79coroutine will start execution at the given coderef. If it returns it
80should return a coroutine to switch to. If, after returning, the coroutine
81is C<resume>d again it starts execution again at the givne coderef.
82
83=cut
84
85sub new {
86 my $class = $_[0];
87 my $proc = $_[1];
88 bless _newprocess {
89 do {
90 eval { &$proc->resume };
91 if ($@) {
92 ($error_msg, $error_coro) = ($@, $current);
93 $error->resume;
94 }
95 } while (1);
96 }, $class;
97}
98
99=item $coro->resume
100
101Resume execution at the given coroutine.
102
103=cut
104
105my $prev;
106
107# I call the _transfer function from a pelr function
108# because that way perl saves all important things on
109# the stack.
110sub resume {
111 $prev = $current; $current = $_[0];
112 _transfer($prev, $current);
113}
114 120
1151; 1211;
116 122
117=back 123=back
118 124

Diff Legend

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