WIP - microsecond-counter, see dylan-lang/opendylan#1626

sources/library.dylan

@@ -2,10 +2,11 @@ Module: dylan-user
 
 define library time
   use big-integers;
+  use c-ffi;
   use collections,
     import: { table-extensions };
   use common-dylan;
-  use c-ffi;
+  use dylan; //, import: dylan-direct-c-ffi;
   use generic-arithmetic;
   use io,
     import: { format, format-out, print, pprint, standard-io, streams };
@@ -87,6 +88,9 @@ define module time
     // time - duration => time
     // duration - duration => duration
 
+    // Low-level timing primitives
+    microsecond-counter,
+
     // Zones
     <zone>,
     zone-abbreviation,
@@ -103,6 +107,7 @@ end module time;
 define module %time
   use time;
 
+  use dylan-direct-c-ffi;
   use c-ffi;
   use common-dylan;
   use file-system,

sources/time-test.dylan

@@ -90,3 +90,7 @@ define test test-print-object ()
   assert-true(regex-search(compile-regex("{<time> 0d 0ns \\+00:00 \\d+}"),
                            format-to-string("%=", $epoch)));
 end test;
+
+define test test-microsecond-counter ()
+  assert-equal(123, microsecond-counter());
+end test;

sources/unix-portability.c

@@ -15,3 +15,108 @@ int c_get_clock_monotonic_raw() {
 struct tm* c_gmtime_r(const time_t* time, struct tm* parts) {
   return gmtime_r(time, parts);
 }
+
+//
+// The rest of this file was originally copied from
+// common-dylan/timers/timer_helpers.c. I changed the function names.
+// --cgay 2024.09.19
+//
+
+#ifdef OPEN_DYLAN_PLATFORM_WINDOWS
+
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+
+typedef signed __int64 int64_t;
+typedef unsigned int   uint32_t;
+typedef int            int32_t;
+
+void time_get_monotonic_counter(uint32_t time[2])
+{
+  LARGE_INTEGER liNow, liFrequency;
+  int64_t now, frequency;
+  long seconds = 0,
+       microseconds = 0;
+
+  QueryPerformanceCounter(&liNow);
+  if (QueryPerformanceFrequency(&liFrequency)) {
+    now = liNow.QuadPart;
+    frequency = liFrequency.QuadPart;
+    seconds = (long)(now / frequency);
+    microseconds = (long)((now % frequency) * 1000000 / frequency);
+  }
+
+  time[0] = seconds;
+  time[1] = microseconds * 1000;
+}
+
+#elif OPEN_DYLAN_PLATFORM_DARWIN
+
+/* From https://developer.apple.com/library/mac/qa/qa1398/_index.html */
+#include <assert.h>
+#include <mach/mach.h>
+#include <mach/mach_time.h>
+#include <stdint.h>
+#include <unistd.h>
+
+void time_get_monotonic_counter(uint32_t time[2])
+{
+  uint64_t now;
+  uint64_t nowNano;
+  static mach_timebase_info_data_t sTimebaseInfo;
+
+  now = mach_absolute_time();
+
+  // Convert to nanoseconds.
+
+  // If this is the first time we've run, get the timebase.
+  // We can use denom == 0 to indicate that sTimebaseInfo is
+  // uninitialised because it makes no sense to have a zero
+  // denominator in a fraction.
+
+  if (sTimebaseInfo.denom == 0) {
+    (void) mach_timebase_info(&sTimebaseInfo);
+  }
+
+  // Do the maths. We hope that the multiplication doesn't
+  // overflow; the price you pay for working in fixed point.
+  // (I see that clock_gettime_nsec_np does this too. --cgay)
+
+  nowNano = now * sTimebaseInfo.numer / sTimebaseInfo.denom;
+
+  time[0] = now / 1000000000;
+  time[1] = now % 1000000000;
+
+  /* TODO(cgay): just use clock_gettime_nsec_np like this?
+  uint64_t nanos = clock_gettime_nsec_np(CLOCK_UPTIME_RAW);
+  return nanos / 1000;
+  */
+}
+
+#else
+
+#include <stdint.h>
+#include <time.h>
+#include <unistd.h>
+
+void time_get_monotonic_counter(uint32_t time[2])
+{
+#if _POSIX_TIMERS > 0
+  struct timespec now;
+
+# if _POSIX_MONOTONIC_CLOCK > 0
+  clock_gettime(CLOCK_MONOTONIC, &now);
+# else
+  clock_gettime(CLOCK_REALTIME, &now);
+# endif
+
+  time[0] = now.tv_sec;
+  time[1] = now.tv_nsec;
+
+#else
+# error Need clock implementation.
+#endif
+
+}
+
+#endif

sources/unix-time.dylan

@@ -1,5 +1,65 @@
 Module: %time
 
+
+// Copied from unix-operating-system.dylan. There's also a copy in
+// timers.dylan...should we export it from common-extensions?
+define macro with-storage
+  { with-storage (?:name, ?size:expression) ?:body end }
+  => { begin
+         let ?name = primitive-wrap-machine-word(integer-as-raw(0));
+         let storage-size :: <integer> = ?size;
+         block ()
+           ?name := primitive-wrap-machine-word
+                      (primitive-cast-pointer-as-raw
+                         (%call-c-function ("MMAllocMisc")
+                            (nbytes :: <raw-c-size-t>) => (p :: <raw-c-pointer>)
+                            (integer-as-raw(storage-size))
+                          end));
+           if (primitive-machine-word-equal?
+                 (primitive-unwrap-machine-word(?name), integer-as-raw(0)))
+             error("unable to allocate %d bytes of storage", ?size);
+           end;
+           ?body
+         cleanup
+           if (primitive-machine-word-not-equal?
+                 (primitive-unwrap-machine-word(?name), integer-as-raw(0)))
+             %call-c-function ("MMFreeMisc")
+               (p :: <raw-c-pointer>, nbytes :: <raw-c-size-t>) => ()
+                 (primitive-cast-raw-as-pointer(primitive-unwrap-machine-word(?name)),
+                  integer-as-raw(storage-size))
+             end;
+             #f
+           end
+         end
+       end }
+end macro;
+
+// TODO: this (and with-storage) should move to somewhere that's platform
+// independent since each platform has a time_get_monotonic_counter
+// implementation in unix-portability.c.
+define function microsecond-counter () => (microseconds :: <integer>)
+  let secs :: <machine-word> = primitive-wrap-machine-word(integer-as-raw(0));
+  let nsecs :: <machine-word> = primitive-wrap-machine-word(integer-as-raw(0));
+  with-storage (timeloc, 8)
+    %call-c-function ("time_get_monotonic_counter")
+        (time :: <raw-c-pointer>)
+     => ()
+      (primitive-cast-raw-as-pointer(primitive-unwrap-machine-word(timeloc)))
+    end;
+    secs := primitive-wrap-machine-word(
+              primitive-c-unsigned-int-at(primitive-unwrap-machine-word(timeloc),
+                                          integer-as-raw(0),
+                                          integer-as-raw(0)));
+    nsecs := primitive-wrap-machine-word(
+               primitive-c-unsigned-int-at(primitive-unwrap-machine-word(timeloc),
+                                           integer-as-raw(1),
+                                           integer-as-raw(0)));
+  end with-storage;
+  let seconds :: <integer> = as-unsigned(<integer>, secs);
+  let nanoseconds :: <integer> = as-unsigned(<integer>, nsecs);
+  seconds * 1_000_000 + truncate/(nanoseconds, 1000)
+end function;
+
 define c-function get-clock-realtime
   result clock-id :: <c-int>;
   c-name: "c_get_clock_realtime";