This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
OS X clock_gettime() and clock_getres() emulation
authorJarkko Hietaniemi <jhi@iki.fi>
Thu, 14 Jan 2016 13:06:26 +0000 (08:06 -0500)
committerJarkko Hietaniemi <jhi@iki.fi>
Sat, 13 Feb 2016 16:39:11 +0000 (11:39 -0500)
Note that CLOCK_REALTIME and CLOCK_MONOTONIC are the same clock,
so both are monotonic.

The difference is that the CLOCK_REALTIME is offset by the
gettimeofday() result on the first use of these interfaces,
and thereafter will closely track the gettimeofday() values.

https://developer.apple.com/library/mac/qa/qa1398/_index.html
"Mach Absolute Time Units"

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

index a4cece2..8b39dfd 100644 (file)
@@ -759,6 +759,103 @@ hrstatns(UV *atime_nsec, UV *mtime_nsec, UV *ctime_nsec)
 #endif /* !TIME_HIRES_STAT */
 }
 
+/* Until Apple implements clock_gettime() (ditto clock_getres())
+ * we will emulate it using Mach interfaces. */
+#if defined(PERL_DARWIN) && !defined(CLOCK_REALTIME)
+
+#  include <mach/mach_time.h>
+
+#  define CLOCK_REALTIME  0x01
+#  define CLOCK_MONOTONIC 0x02
+
+#  define TIMER_ABSTIME   0x01
+
+#ifdef USE_ITHREADS
+STATIC perl_mutex darwin_time_mutex;
+#endif
+
+static uint64_t absolute_time_init;
+static mach_timebase_info_data_t timebase_info;
+static struct timespec timespec_init;
+
+static int darwin_time_init() {
+#ifdef USE_ITHREAD
+  PERL_MUTEX_LOCK(&darwin_time_mutex);
+#endif
+  struct timeval tv;
+  int success = 1;
+  if (absolute_time_init == 0) {
+    /* mach_absolute_time() cannot fail */
+    absolute_time_init = mach_absolute_time();
+    success = mach_timebase_info(&timebase_info) == KERN_SUCCESS;
+    if (success) {
+      success = gettimeofday(&tv, NULL) == 0;
+      if (success) {
+        timespec_init.tv_sec  = tv.tv_sec;
+        timespec_init.tv_nsec = tv.tv_usec * 1000;
+      }
+    }
+  }
+#ifdef USE_ITHREAD
+  PERL_MUTEX_UNLOCK(&darwin_time_mutex);
+#endif
+  return success;
+}
+
+static int clock_gettime(int clock_id, struct timespec *ts) {
+  if (darwin_time_init() && timebase_info.denom) {
+    switch (clock_id) {
+      case CLOCK_REALTIME:
+      {
+       uint64_t nanos =
+         ((mach_absolute_time() - absolute_time_init) *
+          (uint64_t)timebase_info.numer) / (uint64_t)timebase_info.denom;
+       ts->tv_sec  = timespec_init.tv_sec  + nanos / IV_1E9;
+       ts->tv_nsec = timespec_init.tv_nsec + nanos % IV_1E9;
+       return 0;
+      }
+
+      case CLOCK_MONOTONIC:
+      {
+       uint64_t nanos =
+         (mach_absolute_time() *
+          (uint64_t)timebase_info.numer) / (uint64_t)timebase_info.denom;
+       ts->tv_sec  = nanos / IV_1E9;
+       ts->tv_nsec = nanos - ts->tv_sec * IV_1E9;
+       return 0;
+      }
+
+      default:
+       break;
+    }
+  }
+
+  SETERRNO(EINVAL, LIB_INVARG);
+  return -1;
+}
+
+static int clock_getres(int clock_id, struct timespec *ts) {
+  if (darwin_time_init() && timebase_info.denom) {
+    switch (clock_id) {
+      case CLOCK_REALTIME:
+      case CLOCK_MONOTONIC:
+      ts->tv_sec  = 0;
+      /* In newer kernels both the numer and denom are one,
+       * resulting in conversion factor of one, which is of
+       * course unrealistic. */
+      ts->tv_nsec = timebase_info.numer / timebase_info.denom;
+      return 0;
+    default:
+      break;
+    }
+  }
+
+  SETERRNO(EINVAL, LIB_INVARG);
+  return -1;
+}
+
+#endif /* PERL_DARWIN */
+
 #include "const-c.inc"
 
 MODULE = Time::HiRes            PACKAGE = Time::HiRes
index 420841c..5097a69 100644 (file)
@@ -536,6 +536,7 @@ EOD
 
     print "Looking for clock_gettime()... ";
     my $has_clock_gettime;
+    my $has_clock_gettime_emulation;
     if (exists $Config{d_clock_gettime}) {
         $has_clock_gettime++ if $Config{d_clock_gettime}; # Unlikely...
     } elsif (has_clock_xxx('gettime')) {
@@ -544,11 +545,17 @@ EOD
     } elsif (defined $SYSCALL_H && has_clock_xxx_syscall('gettime')) {
         $has_clock_gettime++;
        $DEFINE .= ' -DTIME_HIRES_CLOCK_GETTIME -DTIME_HIRES_CLOCK_GETTIME_SYSCALL';
+    } elsif ($^O eq 'darwin') {
+       $has_clock_gettime_emulation++;
+       $has_clock_gettime++;
+       $DEFINE .= ' -DTIME_HIRES_CLOCK_GETTIME';
     }
 
     if ($has_clock_gettime) {
         if ($DEFINE =~ /-DTIME_HIRES_CLOCK_GETTIME_SYSCALL/) {
            print "found (via syscall).\n";
+       } elsif ($has_clock_gettime_emulation) {
+           print "found (via emulation).\n";
        } else {
            print "found.\n";
        }
@@ -558,6 +565,7 @@ EOD
 
     print "Looking for clock_getres()... ";
     my $has_clock_getres;
+    my $has_clock_getres_emulation;
     if (exists $Config{d_clock_getres}) {
         $has_clock_getres++ if $Config{d_clock_getres}; # Unlikely...
     } elsif (has_clock_xxx('getres')) {
@@ -566,11 +574,17 @@ EOD
     } elsif (defined $SYSCALL_H && has_clock_xxx_syscall('getres')) {
         $has_clock_getres++;
        $DEFINE .= ' -DTIME_HIRES_CLOCK_GETRES -DTIME_HIRES_CLOCK_GETRES_SYSCALL';
+    } elsif ($^O eq 'darwin') {
+       $has_clock_getres_emulation++;
+       $has_clock_getres++;
+       $DEFINE .= ' -DTIME_HIRES_CLOCK_GETRES';
     }
 
     if ($has_clock_getres) {
         if ($DEFINE =~ /-DTIME_HIRES_CLOCK_GETRES_SYSCALL/) {
            print "found (via syscall).\n";
+       } elsif ($has_clock_getres_emulation) {
+           print "found (via emulation).\n";
        } else {
            print "found.\n";
        }
@@ -848,7 +862,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_gettime|d_clock_getres|d_clock|d_clock_nanosleep)$/) {
+           if ($macro =~ /^(d_nanosleep|d_clock|d_clock_nanosleep)$/) {
                $macro =~ s/^d_(.+)/TIME_HIRES_\U$1/;
            } elsif ($macro =~ /^(d_hires_stat)$/) {
                my $d_hires_stat = 0;
@@ -856,6 +870,12 @@ 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)$/) {
+               $macro =~ s/^d_(.+)/TIME_HIRES_\U$1/;
+               my $val = ($DEFINE =~ /-D$macro\b/) ? 1 : 0;
+               push @names, {name => $_, macro => $macro, value => $val,
+                             default => ["IV", "0"]};
+               next;
            } else {
                $macro =~ s/^d_(.+)/HAS_\U$1/;
            }