lib/AnyEvent/Loop.pm

=head1 NAME

AnyEvent::Loop - AnyEvent's Pure-Perl event loop

=head1 SYNOPSIS

   use AnyEvent;
   # use AnyEvent::Loop;
  
   # this module gets loaded automatically when no other loop can be found

   # Explicit use:
   use AnyEvent::Loop;
   use AnyEvent;

   ...

   AnyEvent::Loop::run; # run the event loop

=head1 DESCRIPTION

This module provides an event loop for AnyEvent in case no other event
loop could be found or loaded. You don't have to do anything to make it
work with AnyEvent except by possibly loading it before creating the first
AnyEvent watcher.

This module is I<not> some loop abstracion used by AnyEvent, but just
another event loop like EV or Glib, just written in pure perl and
delivered with AnyEvent, so AnyEvent always works, even in the absence of
any other backend.

If you want to use this module instead of autoloading a potentially better
event loop you can simply load it (and no other event loops) before
creating the first watcher.

As for performance, this module is on par with (and usually faster than)
most select/poll-based C event modules such as Event or Glib (it does not
even come close to EV, though), with respect to I/O watchers. Timers are
handled less optimally, but for many common tasks, it is still on par with
event loops written in C.

This event loop has been optimised for the following use cases:

=over 4

=item monotonic clock is available

This module will use the POSIX monotonic clock option (if it can be
detected at runtime) or the POSIX C<times> function (if the resolution
is at least 100Hz), in which case it will not suffer adversely from time
jumps.

If no monotonic clock is available, this module will not attempt to
correct for time jumps in any way.

The clock chosen will be reported if the environment variable
C<$PERL_ANYEVENT_VERBOSE> is set to 8 or higher.

=item any number of watchers on one fd

Supporting a large number of watchers per fd is purely a dirty benchmark
optimisation not relevant in practise. The more common case of having one
watcher per fd/poll combo is special-cased, however, and therefore fast,
too.

=item relatively few active fds per C<select> call

This module expects that only a tiny amount of fds is active at any one
time. This is relatively typical of larger servers (but not the case where
C<select> traditionally is fast), at the expense of the "dense activity
case" where most of the fds are active (which suits C<select>).

The optimal implementation of the "dense" case is not much faster, though,
so the module should behave very well in most cases, subject to the bad
scalability of C<select> in the presence of a large number of inactive
file descriptors.

=item lots of timer changes/iteration, or none at all

This module sorts the timer list using perl's C<sort>, even though a total
ordering is not required for timers internally.

This sorting is expensive, but means sorting can be avoided unless the
timer list has changed in a way that requires a new sort.

This means that adding lots of timers is very efficient, as well as not
changing the timers. Advancing timers (e.g. recreating a timeout watcher
on activity) is also relatively efficient, for example, if you have a
large number of timeout watchers that time out after 10 seconds, then the
timer list will be sorted only once every 10 seconds.

This should not have much of an impact unless you have hundreds or
thousands of timers, though, or your timers have very small timeouts.

=back

=head1 FUNCTIONS

The only user-visible functions provided by this module loop related -
watchers are created via the normal AnyEvent mechanisms.

=over 4

=item AnyEvent::Loop::run

Run the event loop, usually the last thing done in the main program when
you want to use the pure-perl backend.

=item AnyEvent::Loop::one_event

Blocks until at least one new event has been received by the operating
system, whether or not it was AnyEvent-related.

=back

=cut

package AnyEvent::Loop;

use Scalar::Util qw(weaken);
use List::Util ();

use AnyEvent (); BEGIN { AnyEvent::common_sense }
use AnyEvent::Util ();

our $VERSION = $AnyEvent::VERSION;

our ($NOW, $MNOW);

sub MAXWAIT() { 3600 } # never sleep for longer than this many seconds

BEGIN {
   local $SIG{__DIE__}; # protect us against the many broken __DIE__ handlers out there
   my $time_hires = eval "use Time::HiRes (); 1";
   my $round; # actual granularity

   if ($time_hires && eval "&Time::HiRes::clock_gettime (Time::HiRes::CLOCK_MONOTONIC ())") {
      AE::log 8 => "Using CLOCK_MONOTONIC as timebase.";
      *_update_clock = sub {
         $NOW  = &Time::HiRes::time;
         $MNOW = Time::HiRes::clock_gettime (&Time::HiRes::CLOCK_MONOTONIC);
      };

   } else {
      my $clk_tck = eval "use POSIX (); POSIX::sysconf (POSIX::_SC_CLK_TCK ())";
      
      if (100 <= $clk_tck && $clk_tck <= 1000000 && eval { (POSIX::times ())[0] != -1 }) { # -1 is also a valid return value :/
         AE::log 8 => "Using POSIX::times (monotonic) as timebase.";
         my $HZ1 = 1 / $clk_tck;

         my $last = (POSIX::times ())[0];
         my $next;
         *_update_clock = sub {
            $NOW  = time; # d'oh

            $next = (POSIX::times ())[0];
            # we assume 32 bit signed on wrap but 64 bit will never wrap
            $last -= 4294967296 if $last > $next; # 0x100000000, but perl has problems with big hex constants
            $MNOW += ($next - $last) * $HZ1;
            $last = $next;
         };

         $round = $HZ1;

      } elsif ($time_hires) {
         AE::log 8 => "Using Time::HiRes::time (non-monotonic) clock as timebase.";
         *_update_clock = sub {
            $NOW = $MNOW = &Time::HiRes::time;
         };

      } else {
         AE::log fatal => "Unable to find sub-second time source (is this really perl 5.8.0 or later?)";
      }
   }

   $round = 0.001 if $round < 0.001; # 1ms is enough for us
   $round -= $round * 1e-2; # 0.1 => 0.099
   eval "sub ROUNDUP() { $round }";
}

_update_clock;

# rely on AnyEvent:Base::time to provide time
sub now       () { $NOW          }
sub now_update() { _update_clock }

# fds[0] is for read, fds[1] is for write watchers
# fds[poll][V] is the bitmask for select
# fds[poll][W][fd] contains a list of i/o watchers
# an I/O watcher is a blessed arrayref containing [fh, poll(0/1), callback, queue-index]
# the queue-index is simply the index in the [W] array, which is only used to improve
# benchmark results in the synthetic "many watchers on one fd" benchmark.
my @fds = ([], []);
sub V() { 0 }
sub W() { 1 }

my $need_sort = 1e300; # when to re-sort timer list
my @timer; # list of [ abs-timeout, Timer::[callback] ]
my @idle;  # list of idle callbacks

# the pure perl mainloop
sub one_event {
   _update_clock;

   # first sort timers if required (slow)
   if ($MNOW >= $need_sort) {
      $need_sort = 1e300;
      @timer = sort { $a->[0] <=> $b->[0] } @timer;
   }

   # handle all pending timers
   if (@timer && $timer[0][0] <= $MNOW) {
      do {
         my $timer = shift @timer;
         $timer->[1] && $timer->[1]($timer);
      } while @timer && $timer[0][0] <= $MNOW;

   } else {
      # poll for I/O events, we do not do this when there
      # were any pending timers to ensure that one_event returns
      # quickly when some timers have been handled
      my ($wait, @vec, $fds)
         = (@timer && $timer[0][0] < $need_sort ? $timer[0][0] : $need_sort) - $MNOW;

      $wait = $wait < MAXWAIT ? $wait + ROUNDUP : MAXWAIT;
      $wait = 0 if @idle;

      $fds = CORE::select
        $vec[0] = $fds[0][V],
        $vec[1] = $fds[1][V],
        AnyEvent::WIN32 ? $vec[2] = $fds[1][V] : undef,
        $wait;

      _update_clock;

      if ($fds > 0) {
         # buggy microshit windows errornously sets exceptfds instead of writefds
         $vec[1] |= $vec[2] if AnyEvent::WIN32;

         # prefer write watchers, because they might reduce memory pressure.
         for (1, 0) {
            my $fds = $fds[$_];

            # we parse the bitmask by first expanding it into
            # a string of bits
            for (unpack "b*", $vec[$_]) {
               # and then repeatedly matching a regex against it
               while (/1/g) {
                  # and use the resulting string position as fd
                  $_ && $_->[2]()
                     for @{ $fds->[W][(pos) - 1] || [] };
               }
            }
         }
      } elsif (AnyEvent::WIN32 && $fds && $! == AnyEvent::Util::WSAEINVAL) {
         # buggy microshit windoze asks us to route around it
         CORE::select undef, undef, undef, $wait if $wait;
      } elsif (!@timer || $timer[0][0] > $MNOW && !$fds) {
         $$$_ && $$$_->() for @idle = grep $$$_, @idle;
      }
   }
}

sub run {
   one_event while 1;
}

sub io($$$) {
   my ($fd, $write, $cb) = @_;

   defined ($fd = fileno $fd)
      or $fd = $_[0];

   my $self = bless [
      $fd,
      $write,
      $cb,
      # q-idx
   ], "AnyEvent::Loop::io";

   my $fds = $fds[$self->[1]];

   # add watcher to fds structure
   my $q = $fds->[W][$fd] ||= [];

   (vec $fds->[V], $fd, 1) = 1;

   $self->[3] = @$q;
   push @$q, $self;
   weaken $q->[-1];

   $self
}

sub AnyEvent::Loop::io::DESTROY {
   my ($self) = @_;

   my $fds = $fds[$self->[1]];

   # remove watcher from fds structure
   my $fd = $self->[0];

   if (@{ $fds->[W][$fd] } == 1) {
      delete $fds->[W][$fd];
      (vec $fds->[V], $fd, 1) = 0;
   } else {
      my $q = $fds->[W][$fd];
      my $last = pop @$q;

      if ($last != $self) {
         weaken ($q->[$self->[3]] = $last);
         $last->[3] = $self->[3];
      }
   }
}

sub timer($$$) {
   my ($after, $interval, $cb) = @_;
   
   my $self;

   if ($interval) {
      $self = [$MNOW + $after , sub {
         $_[0][0] = List::Util::max $_[0][0] + $interval, $MNOW;
         push @timer, $_[0];
         weaken $timer[-1];
         $need_sort = $_[0][0] if $_[0][0] < $need_sort;
         &$cb;
      }];
   } else {
      $self = [$MNOW + $after, $cb];
   }

   push @timer, $self;
   weaken $timer[-1];
   $need_sort = $self->[0] if $self->[0] < $need_sort;

   $self
}

sub idle($) {
   my $cb = shift;

   push @idle, \\$cb;
   weaken ${$idle[-1]};

   ${$idle[-1]}
}

=head1 SEE ALSO

L<AnyEvent>.

=head1 AUTHOR

   Marc Lehmann <schmorp@schmorp.de>
   http://anyevent.schmorp.de

=cut

1

Revision:	1.12
Committed:	Wed Nov 27 19:59:20 2019 UTC (5 years ago) by root
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.11:	+29 -26 lines
Log Message:	* empty log message *
#	Content
1	=head1 NAME
2
3	AnyEvent::Loop - AnyEvent's Pure-Perl event loop
4
5	=head1 SYNOPSIS
6
7	use AnyEvent;
8	# use AnyEvent::Loop;
9
10	# this module gets loaded automatically when no other loop can be found
11
12	# Explicit use:
13	use AnyEvent::Loop;
14	use AnyEvent;
15
16	...
17
18	AnyEvent::Loop::run; # run the event loop
19
20	=head1 DESCRIPTION
21
22	This module provides an event loop for AnyEvent in case no other event
23	loop could be found or loaded. You don't have to do anything to make it
24	work with AnyEvent except by possibly loading it before creating the first
25	AnyEvent watcher.
26
27	This module is I<not> some loop abstracion used by AnyEvent, but just
28	another event loop like EV or Glib, just written in pure perl and
29	delivered with AnyEvent, so AnyEvent always works, even in the absence of
30	any other backend.
31
32	If you want to use this module instead of autoloading a potentially better
33	event loop you can simply load it (and no other event loops) before
34	creating the first watcher.
35
36	As for performance, this module is on par with (and usually faster than)
37	most select/poll-based C event modules such as Event or Glib (it does not
38	even come close to EV, though), with respect to I/O watchers. Timers are
39	handled less optimally, but for many common tasks, it is still on par with
40	event loops written in C.
41
42	This event loop has been optimised for the following use cases:
43
44	=over 4
45
46	=item monotonic clock is available
47
48	This module will use the POSIX monotonic clock option (if it can be
49	detected at runtime) or the POSIX C<times> function (if the resolution
50	is at least 100Hz), in which case it will not suffer adversely from time
51	jumps.
52
53	If no monotonic clock is available, this module will not attempt to
54	correct for time jumps in any way.
55
56	The clock chosen will be reported if the environment variable
57	C<$PERL_ANYEVENT_VERBOSE> is set to 8 or higher.
58
59	=item any number of watchers on one fd
60
61	Supporting a large number of watchers per fd is purely a dirty benchmark
62	optimisation not relevant in practise. The more common case of having one
63	watcher per fd/poll combo is special-cased, however, and therefore fast,
64	too.
65
66	=item relatively few active fds per C<select> call
67
68	This module expects that only a tiny amount of fds is active at any one
69	time. This is relatively typical of larger servers (but not the case where
70	C<select> traditionally is fast), at the expense of the "dense activity
71	case" where most of the fds are active (which suits C<select>).
72
73	The optimal implementation of the "dense" case is not much faster, though,
74	so the module should behave very well in most cases, subject to the bad
75	scalability of C<select> in the presence of a large number of inactive
76	file descriptors.
77
78	=item lots of timer changes/iteration, or none at all
79
80	This module sorts the timer list using perl's C<sort>, even though a total
81	ordering is not required for timers internally.
82
83	This sorting is expensive, but means sorting can be avoided unless the
84	timer list has changed in a way that requires a new sort.
85
86	This means that adding lots of timers is very efficient, as well as not
87	changing the timers. Advancing timers (e.g. recreating a timeout watcher
88	on activity) is also relatively efficient, for example, if you have a
89	large number of timeout watchers that time out after 10 seconds, then the
90	timer list will be sorted only once every 10 seconds.
91
92	This should not have much of an impact unless you have hundreds or
93	thousands of timers, though, or your timers have very small timeouts.
94
95	=back
96
97	=head1 FUNCTIONS
98
99	The only user-visible functions provided by this module loop related -
100	watchers are created via the normal AnyEvent mechanisms.
101
102	=over 4
103
104	=item AnyEvent::Loop::run
105
106	Run the event loop, usually the last thing done in the main program when
107	you want to use the pure-perl backend.
108
109	=item AnyEvent::Loop::one_event
110
111	Blocks until at least one new event has been received by the operating
112	system, whether or not it was AnyEvent-related.
113
114	=back
115
116	=cut
117
118	package AnyEvent::Loop;
119
120	use Scalar::Util qw(weaken);
121	use List::Util ();
122
123	use AnyEvent (); BEGIN { AnyEvent::common_sense }
124	use AnyEvent::Util ();
125
126	our $VERSION = $AnyEvent::VERSION;
127
128	our ($NOW, $MNOW);
129
130	sub MAXWAIT() { 3600 } # never sleep for longer than this many seconds
131
132	BEGIN {
133	local $SIG{__DIE__}; # protect us against the many broken __DIE__ handlers out there
134	my $time_hires = eval "use Time::HiRes (); 1";
135	my $round; # actual granularity
136
137	if ($time_hires && eval "&Time::HiRes::clock_gettime (Time::HiRes::CLOCK_MONOTONIC ())") {
138	AE::log 8 => "Using CLOCK_MONOTONIC as timebase.";
139	*_update_clock = sub {
140	$NOW = &Time::HiRes::time;
141	$MNOW = Time::HiRes::clock_gettime (&Time::HiRes::CLOCK_MONOTONIC);
142	};
143
144	} else {
145	my $clk_tck = eval "use POSIX (); POSIX::sysconf (POSIX::_SC_CLK_TCK ())";
146
147	if (100 <= $clk_tck && $clk_tck <= 1000000 && eval { (POSIX::times ())[0] != -1 }) { # -1 is also a valid return value :/
148	AE::log 8 => "Using POSIX::times (monotonic) as timebase.";
149	my $HZ1 = 1 / $clk_tck;
150
151	my $last = (POSIX::times ())[0];
152	my $next;
153	*_update_clock = sub {
154	$NOW = time; # d'oh
155
156	$next = (POSIX::times ())[0];
157	# we assume 32 bit signed on wrap but 64 bit will never wrap
158	$last -= 4294967296 if $last > $next; # 0x100000000, but perl has problems with big hex constants
159	$MNOW += ($next - $last) * $HZ1;
160	$last = $next;
161	};
162
163	$round = $HZ1;
164
165	} elsif ($time_hires) {
166	AE::log 8 => "Using Time::HiRes::time (non-monotonic) clock as timebase.";
167	*_update_clock = sub {
168	$NOW = $MNOW = &Time::HiRes::time;
169	};
170
171	} else {
172	AE::log fatal => "Unable to find sub-second time source (is this really perl 5.8.0 or later?)";
173	}
174	}
175
176	$round = 0.001 if $round < 0.001; # 1ms is enough for us
177	$round -= $round * 1e-2; # 0.1 => 0.099
178	eval "sub ROUNDUP() { $round }";
179	}
180
181	_update_clock;
182
183	# rely on AnyEvent:Base::time to provide time
184	sub now () { $NOW }
185	sub now_update() { _update_clock }
186
187	# fds[0] is for read, fds[1] is for write watchers
188	# fds[poll][V] is the bitmask for select
189	# fds[poll][W][fd] contains a list of i/o watchers
190	# an I/O watcher is a blessed arrayref containing [fh, poll(0/1), callback, queue-index]
191	# the queue-index is simply the index in the [W] array, which is only used to improve
192	# benchmark results in the synthetic "many watchers on one fd" benchmark.
193	my @fds = ([], []);
194	sub V() { 0 }
195	sub W() { 1 }
196
197	my $need_sort = 1e300; # when to re-sort timer list
198	my @timer; # list of [ abs-timeout, Timer::[callback] ]
199	my @idle; # list of idle callbacks
200
201	# the pure perl mainloop
202	sub one_event {
203	_update_clock;
204
205	# first sort timers if required (slow)
206	if ($MNOW >= $need_sort) {
207	$need_sort = 1e300;
208	@timer = sort { $a->[0] <=> $b->[0] } @timer;
209	}
210
211	# handle all pending timers
212	if (@timer && $timer[0][0] <= $MNOW) {
213	do {
214	my $timer = shift @timer;
215	$timer->[1] && $timer->[1]($timer);
216	} while @timer && $timer[0][0] <= $MNOW;
217
218	} else {
219	# poll for I/O events, we do not do this when there
220	# were any pending timers to ensure that one_event returns
221	# quickly when some timers have been handled
222	my ($wait, @vec, $fds)
223	= (@timer && $timer[0][0] < $need_sort ? $timer[0][0] : $need_sort) - $MNOW;
224
225	$wait = $wait < MAXWAIT ? $wait + ROUNDUP : MAXWAIT;
226	$wait = 0 if @idle;
227
228	$fds = CORE::select
229	$vec[0] = $fds[0][V],
230	$vec[1] = $fds[1][V],
231	AnyEvent::WIN32 ? $vec[2] = $fds[1][V] : undef,
232	$wait;
233
234	_update_clock;
235
236	if ($fds > 0) {
237	# buggy microshit windows errornously sets exceptfds instead of writefds
238	$vec[1] \|= $vec[2] if AnyEvent::WIN32;
239
240	# prefer write watchers, because they might reduce memory pressure.
241	for (1, 0) {
242	my $fds = $fds[$_];
243
244	# we parse the bitmask by first expanding it into
245	# a string of bits
246	for (unpack "b*", $vec[$_]) {
247	# and then repeatedly matching a regex against it
248	while (/1/g) {
249	# and use the resulting string position as fd
250	$_ && $_->[2]()
251	for @{ $fds->[W][(pos) - 1] \|\| [] };
252	}
253	}
254	}
255	} elsif (AnyEvent::WIN32 && $fds && $! == AnyEvent::Util::WSAEINVAL) {
256	# buggy microshit windoze asks us to route around it
257	CORE::select undef, undef, undef, $wait if $wait;
258	} elsif (!@timer \|\| $timer[0][0] > $MNOW && !$fds) {
259	$$$_ && $$$_->() for @idle = grep $$$_, @idle;
260	}
261	}
262	}
263
264	sub run {
265	one_event while 1;
266	}
267
268	sub io($$$) {
269	my ($fd, $write, $cb) = @_;
270
271	defined ($fd = fileno $fd)
272	or $fd = $_[0];
273
274	my $self = bless [
275	$fd,
276	$write,
277	$cb,
278	# q-idx
279	], "AnyEvent::Loop::io";
280
281	my $fds = $fds[$self->[1]];
282
283	# add watcher to fds structure
284	my $q = $fds->[W][$fd] \|\|= [];
285
286	(vec $fds->[V], $fd, 1) = 1;
287
288	$self->[3] = @$q;
289	push @$q, $self;
290	weaken $q->[-1];
291
292	$self
293	}
294
295	sub AnyEvent::Loop::io::DESTROY {
296	my ($self) = @_;
297
298	my $fds = $fds[$self->[1]];
299
300	# remove watcher from fds structure
301	my $fd = $self->[0];
302
303	if (@{ $fds->[W][$fd] } == 1) {
304	delete $fds->[W][$fd];
305	(vec $fds->[V], $fd, 1) = 0;
306	} else {
307	my $q = $fds->[W][$fd];
308	my $last = pop @$q;
309
310	if ($last != $self) {
311	weaken ($q->[$self->[3]] = $last);
312	$last->[3] = $self->[3];
313	}
314	}
315	}
316
317	sub timer($$$) {
318	my ($after, $interval, $cb) = @_;
319
320	my $self;
321
322	if ($interval) {
323	$self = [$MNOW + $after , sub {
324	$_[0][0] = List::Util::max $_[0][0] + $interval, $MNOW;
325	push @timer, $_[0];
326	weaken $timer[-1];
327	$need_sort = $_[0][0] if $_[0][0] < $need_sort;
328	&$cb;
329	}];
330	} else {
331	$self = [$MNOW + $after, $cb];
332	}
333
334	push @timer, $self;
335	weaken $timer[-1];
336	$need_sort = $self->[0] if $self->[0] < $need_sort;
337
338	$self
339	}
340
341	sub idle($) {
342	my $cb = shift;
343
344	push @idle, \\$cb;
345	weaken ${$idle[-1]};
346
347	${$idle[-1]}
348	}
349
350	=head1 SEE ALSO
351
352	L<AnyEvent>.
353
354	=head1 AUTHOR
355
356	Marc Lehmann <schmorp@schmorp.de>
357	http://anyevent.schmorp.de
358
359	=cut
360
361	1
362