Coro/Coro.pm

=head1 NAME

Coro - coroutine process abstraction

=head1 SYNOPSIS

 use Coro;

 async {
    # some asynchronous thread of execution
 };

 # alternatively create an async process like this:

 sub some_func : Coro {
    # some more async code
 }

 yield;

=head1 DESCRIPTION

=cut

package Coro;

use Coro::State;

use base Exporter;

$VERSION = 0.03;

@EXPORT = qw(async yield schedule);
@EXPORT_OK = qw($current);

{
   use subs 'async';

   my @async;

   # this way of handling attributes simply is NOT scalable ;()
   sub import {
      Coro->export_to_level(1, @_);
      my $old = *{(caller)[0]."::MODIFY_CODE_ATTRIBUTES"}{CODE};
      *{(caller)[0]."::MODIFY_CODE_ATTRIBUTES"} = sub {
         my ($package, $ref) = (shift, shift);
         my @attrs;
         for (@_) {
            if ($_ eq "Coro") {
               push @async, $ref;
            } else {
               push @attrs, @_;
            }
         }
         return $old ? $old->($package, $name, @attrs) : @attrs;
      };
   }

   sub INIT {
      async pop @async while @async;
   }
}

my $idle = new Coro sub {
   &yield while 1;
};

=item $main

This coroutine represents the main program.

=cut

$main = new Coro;

=item $current

The current coroutine (the last coroutine switched to). The initial value is C<$main> (of course).

=cut

# maybe some other module used Coro::Specific before...
if ($current) {
   $main->{specific} = $current->{specific};
}

$current = $main;

# we really need priorities...
my @ready = (); # the ready queue. hehe, rather broken ;)

# static methods. not really.

=head2 STATIC METHODS

Static methods are actually functions that operate on the current process only.

=over 4

=item async { ... };

Create a new asynchronous process and return it's process object
(usually unused). When the sub returns the new process is automatically
terminated.

=cut

sub async(&) {
   (new Coro $_[0])->ready;
}

=item schedule

Calls the scheduler. Please note that the current process will not be put
into the ready queue, so calling this function usually means you will
never be called again.

=cut

my $prev;

sub schedule {
   ($prev, $current) = ($current, shift @ready);
   Coro::State::transfer($prev, $current);
}

=item yield

Yield to other processes. This function puts the current process into the
ready queue and calls C<schedule>.

=cut

sub yield {
   $current->ready;
   &schedule;
}

=item terminate

Terminates the current process.

=cut

sub terminate {
   &schedule;
}

=back

# dynamic methods

=head2 PROCESS METHODS

These are the methods you can call on process objects.

=over 4

=item new Coro \&sub;

Create a new process and return it. When the sub returns the process
automatically terminates. To start the process you must first put it into
the ready queue by calling the ready method.

=cut

sub new {
   my $class = shift;
   my $proc = $_[0];
   bless {
      _coro_state => new Coro::State ($proc ? sub { &$proc; &terminate } : $proc),
   }, $class;
}

=item $process->ready

Put the current process into the ready queue.

=cut

sub ready {
   push @ready, $_[0];
}

=back

=cut

1;

=head1 AUTHOR

 Marc Lehmann <pcg@goof.com>
 http://www.goof.com/pcg/marc/

=cut

Revision:	1.8
Committed:	Sat Jul 14 22:14:21 2001 UTC (22 years, 10 months ago) by root
Branch:	MAIN
Changes since 1.7:	+141 -83 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3	root	1.8	Coro - coroutine process abstraction
4	root	1.1
5			=head1 SYNOPSIS
6
7			use Coro;
8
9	root	1.8	async {
10			# some asynchronous thread of execution
11	root	1.2	};
12
13	root	1.8	# alternatively create an async process like this:
14	root	1.6
15	root	1.8	sub some_func : Coro {
16			# some more async code
17			}
18
19			yield;
20	root	1.2
21	root	1.1	=head1 DESCRIPTION
22
23	root	1.8	=cut
24
25			package Coro;
26
27			use Coro::State;
28
29			use base Exporter;
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			}
62			}
63
64			my $idle = new Coro sub {
65			&yield while 1;
66			};
67
68			=item $main
69	root	1.2
70	root	1.8	This coroutine represents the main program.
71	root	1.1
72			=cut
73
74	root	1.8	$main = new Coro;
75
76			=item $current
77	root	1.1
78	root	1.8	The current coroutine (the last coroutine switched to). The initial value is C<$main> (of course).
79	root	1.1
80	root	1.8	=cut
81
82			# maybe some other module used Coro::Specific before...
83			if ($current) {
84			$main->{specific} = $current->{specific};
85	root	1.1	}
86
87	root	1.8	$current = $main;
88
89			# we really need priorities...
90			my @ready = (); # the ready queue. hehe, rather broken ;)
91
92			# static methods. not really.
93
94			=head2 STATIC METHODS
95
96			Static methods are actually functions that operate on the current process only.
97
98			=over 4
99
100			=item async { ... };
101
102			Create a new asynchronous process and return it's process object
103			(usually unused). When the sub returns the new process is automatically
104			terminated.
105
106			=cut
107
108			sub async(&) {
109			(new Coro $_[0])->ready;
110			}
111	root	1.1
112	root	1.8	=item schedule
113	root	1.6
114	root	1.8	Calls the scheduler. Please note that the current process will not be put
115			into the ready queue, so calling this function usually means you will
116			never be called again.
117	root	1.1
118			=cut
119
120	root	1.8	my $prev;
121
122			sub schedule {
123			($prev, $current) = ($current, shift @ready);
124			Coro::State::transfer($prev, $current);
125	root	1.1	}
126
127	root	1.8	=item yield
128	root	1.1
129	root	1.8	Yield to other processes. This function puts the current process into the
130			ready queue and calls C<schedule>.
131	root	1.7
132	root	1.8	=cut
133
134			sub yield {
135			$current->ready;
136			&schedule;
137			}
138	root	1.7
139	root	1.8	=item terminate
140	root	1.7
141	root	1.8	Terminates the current process.
142	root	1.1
143			=cut
144
145	root	1.8	sub terminate {
146			&schedule;
147	root	1.1	}
148	root	1.6
149	root	1.8	=back
150
151			# dynamic methods
152
153			=head2 PROCESS METHODS
154
155			These are the methods you can call on process objects.
156	root	1.6
157	root	1.8	=over 4
158
159			=item new Coro \⊂
160
161			Create a new process and return it. When the sub returns the process
162			automatically terminates. To start the process you must first put it into
163			the ready queue by calling the ready method.
164	root	1.6
165			=cut
166
167	root	1.8	sub new {
168			my $class = shift;
169			my $proc = $_[0];
170			bless {
171			_coro_state => new Coro::State ($proc ? sub { &$proc; &terminate } : $proc),
172			}, $class;
173			}
174	root	1.6
175	root	1.8	=item $process->ready
176	root	1.1
177	root	1.8	Put the current process into the ready queue.
178	root	1.1
179	root	1.8	=cut
180	root	1.1
181	root	1.8	sub ready {
182			push @ready, $_[0];
183			}
184	root	1.1
185	root	1.8	=back
186	root	1.2
187	root	1.8	=cut
188	root	1.2
189	root	1.8	1;
190	root	1.1
191			=head1 AUTHOR
192
193			Marc Lehmann <pcg@goof.com>
194			http://www.goof.com/pcg/marc/
195
196			=cut
197