OS X clock_nanosleep() emulation
authorJarkko Hietaniemi <jhi@iki.fi>
Thu, 14 Jan 2016 02:47:44 +0000 (21:47 -0500)
committerJarkko Hietaniemi <jhi@iki.fi>
Sat, 13 Feb 2016 16:39:11 +0000 (11:39 -0500)
https://developer.apple.com/library/ios/technotes/tn2169/_index.html
"High Precision Timers in iOS / OS X"

Returning the unspent time in the case of relative sleep is not implemented.

dist/Time-HiRes/HiRes.pm
dist/Time-HiRes/HiRes.xs
dist/Time-HiRes/Makefile.PL

index 6502b13..1f4801b 100644 (file)
@@ -578,6 +578,9 @@ might help in this (in case your system supports CLOCK_MONOTONIC).
 Some systems have APIs but not implementations: for example QNX and Haiku
 have the interval timer APIs but not the functionality.
 
+In OS X the clock_nanosleep() is emulated using the Mach timers;
+as a side effect the CLOCK_REALTIME and CLOCK_MONOTONIC are the same timer.
+
 =head1 SEE ALSO
 
 Perl modules L<BSD::Resource>, L<Time::TAI64>.
index 8b39dfd..2efc018 100644 (file)
@@ -854,6 +854,44 @@ static int clock_getres(int clock_id, struct timespec *ts) {
   return -1;
 }
 
+static int clock_nanosleep(int clock_id, int flags,
+                          const struct timespec *rqtp,
+                          struct timespec *rmtp) {
+  if (darwin_time_init()) {
+    switch (clock_id) {
+    case CLOCK_REALTIME:
+    case CLOCK_MONOTONIC:
+      {
+       uint64_t nanos = rqtp->tv_sec * IV_1E9 + rqtp->tv_nsec;
+        int success;
+       if ((flags & TIMER_ABSTIME)) {
+         uint64_t back =
+           timespec_init.tv_sec * IV_1E9 + timespec_init.tv_nsec;
+         nanos = nanos > back ? nanos - back : 0;
+       }
+        success =
+          mach_wait_until(mach_absolute_time() + nanos) == KERN_SUCCESS;
+
+        /* In the relative sleep, the rmtp should be filled in with
+         * the 'unused' part of the rqtp in case the sleep gets
+         * interrupted by a signal.  But it is unknown how signals
+         * interact with mach_wait_until().  In the absolute sleep,
+         * the rmtp should stay untouched. */
+        rmtp->tv_sec  = 0;
+        rmtp->tv_nsec = 0;
+
+        return success;
+      }
+
+    default:
+      break;
+    }
+  }
+
+  SETERRNO(EINVAL, LIB_INVARG);
+  return -1;
+}
+
 #endif /* PERL_DARWIN */
 
 #include "const-c.inc"
index 5097a69..89594e6 100644 (file)
@@ -594,15 +594,24 @@ EOD
 
     print "Looking for clock_nanosleep()... ";
     my $has_clock_nanosleep;
+    my $has_clock_nanosleep_emulation;
     if (exists $Config{d_clock_nanosleep}) {
         $has_clock_nanosleep++ if $Config{d_clock_nanosleep}; # Unlikely...
     } elsif (has_clock_nanosleep()) {
         $has_clock_nanosleep++;
        $DEFINE .= ' -DTIME_HIRES_CLOCK_NANOSLEEP';
+    } elsif ($^O eq 'darwin') {
+        $has_clock_nanosleep++;
+        $has_clock_nanosleep_emulation++;
+       $DEFINE .= ' -DTIME_HIRES_CLOCK_NANOSLEEP';
     }
 
     if ($has_clock_nanosleep) {
-        print "found.\n";
+       if ($has_clock_nanosleep_emulation) {
+           print "found (via emulation).\n";
+       } else {
+           print "found.\n";
+       }
     } else {
        print "NOT found.\n";
     }
@@ -862,7 +871,7 @@ sub doConstants {
                     d_nanosleep d_clock_gettime d_clock_getres
                     d_clock d_clock_nanosleep d_hires_stat)) {
            my $macro = $_;
-           if ($macro =~ /^(d_nanosleep|d_clock|d_clock_nanosleep)$/) {
+           if ($macro =~ /^(d_nanosleep|d_clock)$/) {
                $macro =~ s/^d_(.+)/TIME_HIRES_\U$1/;
            } elsif ($macro =~ /^(d_hires_stat)$/) {
                my $d_hires_stat = 0;
@@ -870,7 +879,7 @@ sub doConstants {
                push @names, {name => $_, macro => "TIME_HIRES_STAT", value => $d_hires_stat,
                              default => ["IV", "0"]};
                next;
-           } elsif ($macro =~ /^(d_clock_gettime|d_clock_getres)$/) {
+           } elsif ($macro =~ /^(d_clock_gettime|d_clock_getres|d_clock_nanosleep)$/) {
                $macro =~ s/^d_(.+)/TIME_HIRES_\U$1/;
                my $val = ($DEFINE =~ /-D$macro\b/) ? 1 : 0;
                push @names, {name => $_, macro => $macro, value => $val,