trace-resources: Patch up CPU time metric on darwin

Author: Russoul

trace-resources/cbits/os-support-darwin.c

@@ -12,6 +12,7 @@
 #include <mach/mach_host.h>
 #include <net/route.h>
 #include <net/if_dl.h>
+#include <libproc.h>
 
 /*
 // includes for c_get_sys_disk_io_counters
@@ -270,3 +271,19 @@ int c_get_sys_network_io_counters2(NET_IO *counters) {
     free(msghdrbuf);
     return 1;
 }
+
+uint64_t c_get_process_cpu_time_microseconds(pid_t pid) {
+    struct proc_taskinfo ti;
+
+    int ret = proc_pidinfo(pid, PROC_PIDTASKINFO, 0, &ti, sizeof(ti));
+
+    if (ret <= 0) {
+        perror("proc_pidinfo");
+        return 0;
+    }
+
+    uint64_t user_microsec = ti.pti_total_user / 1e3;
+    uint64_t sys_microsec  = ti.pti_total_system / 1e3;
+
+    return user_microsec + sys_microsec;
+}

trace-resources/include/os-support-darwin.h

@@ -35,3 +35,4 @@ long c_get_boot_time2();
 int c_get_sys_cpu_times2(CPU_TIMES *counters);
 int c_get_sys_network_io_counters2(NET_IO *counters);
 int c_get_sys_disk_io_counters2(DISK_COUNTERS *counters);
+uint64_t c_get_process_cpu_time_microseconds(pid_t);

trace-resources/src/Cardano/Logging/Resources/Darwin.hsc

@@ -74,6 +74,8 @@ instance Storable MachTaskBasicInfo where
 
 foreign import ccall unsafe c_get_process_memory_info2 :: Ptr MachTaskBasicInfo -> CInt -> IO CInt
 
+foreign import ccall unsafe c_get_process_cpu_time_microseconds :: CInt -> IO Word64
+
 
 getMemoryInfo :: ProcessID -> IO MachTaskBasicInfo
 getMemoryInfo pid =
@@ -84,13 +86,12 @@ getMemoryInfo pid =
 
 readResourceStatsInternal :: IO (Maybe ResourceStats)
 readResourceStatsInternal = getProcessID >>= \pid -> do
-  cpu <- getMemoryInfo pid
   rts <- GhcStats.getRTSStats
   mem <- getMemoryInfo pid
+  cpuTimeMicro <- c_get_process_cpu_time_microseconds (fromIntegral pid)
   pure . Just $
     Resources
-    { rCentiCpu   = timeValToCenti (_user_time cpu)
-                  + timeValToCenti (_system_time cpu)
+    { rCentiCpu   = usToCenti cpuTimeMicro
     , rCentiGC    = nsToCenti $ GhcStats.gc_cpu_ns rts
     , rCentiMut   = nsToCenti $ GhcStats.mutator_cpu_ns rts
     , rGcsMajor   = fromIntegral $ GhcStats.major_gcs rts
@@ -109,8 +110,5 @@ readResourceStatsInternal = getProcessID >>= \pid -> do
  where
    nsToCenti :: GhcStats.RtsTime -> Word64
    nsToCenti = fromIntegral . (`div` 10000000)
-   timeValToCenti :: TIME_VALUE_T -> Word64
-   timeValToCenti tv = usFromTimeValue tv `div` 10000
-
-usFromTimeValue :: TIME_VALUE_T -> Word64
-usFromTimeValue (TIME_VALUE_T s us) = s * 1000000 + us
+   usToCenti :: Word64 -> Word64
+   usToCenti = (`div` 10000)