- return $LoopTimeout unless @Timers;
-
- my $now = Time::HiRes::time();
-
- # Run expired timers
- while (@Timers && $Timers[0][0] <= $now) {
- my $to_run = shift(@Timers);
- $to_run->[1]->($now) if $to_run->[1];
- }
-
- return $LoopTimeout unless @Timers;
-
- # convert time to an even number of milliseconds, adding 1
- # extra, otherwise floating point fun can occur and we'll
- # call RunTimers like 20-30 times, each returning a timeout
- # of 0.0000212 seconds
- my $timeout = int(($Timers[0][0] - $now) * 1000) + 1;
-
- # -1 is an infinite timeout, so prefer a real timeout
- return $timeout if $LoopTimeout == -1;
-
- # otherwise pick the lower of our regular timeout and time until
- # the next timer
- return $LoopTimeout if $LoopTimeout < $timeout;
- return $timeout;
-}
-
-### The epoll-based event loop. Gets installed as EventLoop if IO::Epoll loads
-### okay.
-sub EpollEventLoop {
- my $class = shift;
-
- foreach my $fd ( keys %OtherFds ) {
- if (epoll_ctl($Epoll, EPOLL_CTL_ADD, $fd, EPOLLIN) == -1) {
- warn "epoll_ctl(): failure adding fd=$fd; $! (", $!+0, ")\n";
- }
- }
-
- while (1) {
- my @events;
- my $i;
- my $timeout = RunTimers();
-
- # get up to 1000 events
- my $evcount = epoll_wait($Epoll, 1000, $timeout, \@events);
- EVENT:
- for ($i=0; $i<$evcount; $i++) {
- my $ev = $events[$i];
-
- # it's possible epoll_wait returned many events, including some at the end
- # that ones in the front triggered unregister-interest actions. if we
- # can't find the %sock entry, it's because we're no longer interested
- # in that event.
- my PublicInbox::DS $pob = $DescriptorMap{$ev->[0]};
- my $code;
- my $state = $ev->[1];
-
- # if we didn't find a Perlbal::Socket subclass for that fd, try other
- # pseudo-registered (above) fds.
- if (! $pob) {
- if (my $code = $OtherFds{$ev->[0]}) {
- $code->($state);
- } else {
- my $fd = $ev->[0];
- warn "epoll() returned fd $fd w/ state $state for which we have no mapping. removing.\n";
- POSIX::close($fd);
- epoll_ctl($Epoll, EPOLL_CTL_DEL, $fd, 0);
- }
- next;
- }
-
- DebugLevel >= 1 && $class->DebugMsg("Event: fd=%d (%s), state=%d \@ %s\n",
- $ev->[0], ref($pob), $ev->[1], time);
-
- # standard non-profiling codepat
- $pob->event_read if $state & EPOLLIN && ! $pob->{closed};
- $pob->event_write if $state & EPOLLOUT && ! $pob->{closed};
- if ($state & (EPOLLERR|EPOLLHUP)) {
- $pob->event_err if $state & EPOLLERR && ! $pob->{closed};
- $pob->event_hup if $state & EPOLLHUP && ! $pob->{closed};
- }
- }
- return unless PostEventLoop();
- }
- exit 0;
-}
-
-### The fallback IO::Poll-based event loop. Gets installed as EventLoop if
-### IO::Epoll fails to load.
-sub PollEventLoop {
- my $class = shift;
-
- my PublicInbox::DS $pob;
-
- while (1) {
- my $timeout = RunTimers();
-
- # the following sets up @poll as a series of ($poll,$event_mask)
- # items, then uses IO::Poll::_poll, implemented in XS, which
- # modifies the array in place with the even elements being
- # replaced with the event masks that occured.
- my @poll;
- foreach my $fd ( keys %OtherFds ) {
- push @poll, $fd, POLLIN;
- }
- while ( my ($fd, $sock) = each %DescriptorMap ) {
- push @poll, $fd, $sock->{event_watch};
- }
-
- # if nothing to poll, either end immediately (if no timeout)
- # or just keep calling the callback
- unless (@poll) {
- select undef, undef, undef, ($timeout / 1000);
- return unless PostEventLoop();
- next;
- }
-
- my $count = IO::Poll::_poll($timeout, @poll);
- unless ($count >= 0) {
- return unless PostEventLoop();
- next;
- }
-
- # Fetch handles with read events
- while (@poll) {
- my ($fd, $state) = splice(@poll, 0, 2);
- next unless $state;
-
- $pob = $DescriptorMap{$fd};
+ next_tick();
+
+ return (($nextq || $ToClose) ? 0 : $LoopTimeout) unless @Timers;
+
+ my $now = now();
+
+ # Run expired timers
+ while (@Timers && $Timers[0][0] <= $now) {
+ my $to_run = shift(@Timers);
+ delete $UniqTimer{$to_run->[1] // ''};
+ $to_run->[2]->(@$to_run[3..$#$to_run]);
+ }
+
+ # timers may enqueue into nextq:
+ return 0 if ($nextq || $ToClose);
+
+ return $LoopTimeout unless @Timers;
+
+ # convert time to an even number of milliseconds, adding 1
+ # extra, otherwise floating point fun can occur and we'll
+ # call RunTimers like 20-30 times, each returning a timeout
+ # of 0.0000212 seconds
+ my $timeout = int(($Timers[0][0] - $now) * 1000) + 1;
+
+ # -1 is an infinite timeout, so prefer a real timeout
+ ($LoopTimeout < 0 || $LoopTimeout >= $timeout) ? $timeout : $LoopTimeout
+}
+
+sub sig_setmask { sigprocmask(SIG_SETMASK, @_) or die "sigprocmask: $!" }
+
+sub block_signals () {
+ my $oldset = POSIX::SigSet->new;
+ my $newset = POSIX::SigSet->new;
+ $newset->fillset or die "fillset: $!";
+ sig_setmask($newset, $oldset);
+ $oldset;
+}
+
+# We can't use waitpid(-1) safely here since it can hit ``, system(),
+# and other things. So we scan the $wait_pids list, which is hopefully
+# not too big. We keep $wait_pids small by not calling dwaitpid()
+# until we've hit EOF when reading the stdout of the child.
+
+sub reap_pids {
+ $reap_armed = undef;
+ my $tmp = $wait_pids or return;
+ $wait_pids = undef;
+ $Stack{reap_runq} = $tmp;
+ my $oldset = block_signals();
+ foreach my $ary (@$tmp) {
+ my ($pid, $cb, $arg) = @$ary;
+ my $ret = waitpid($pid, WNOHANG);
+ if ($ret == 0) {
+ push @$wait_pids, $ary; # autovivifies @$wait_pids
+ } elsif ($ret == $pid) {
+ if ($cb) {
+ eval { $cb->($arg, $pid) };
+ warn "E: dwaitpid($pid) in_loop: $@" if $@;
+ }
+ } else {
+ warn "waitpid($pid, WNOHANG) = $ret, \$!=$!, \$?=$?";
+ }
+ }
+ sig_setmask($oldset);
+ delete $Stack{reap_runq};
+}
+
+# reentrant SIGCHLD handler (since reap_pids is not reentrant)
+sub enqueue_reap () { $reap_armed //= requeue(\&reap_pids) }
+
+sub in_loop () { $in_loop }