From ef0857f398e3c102e4c3cb65a818ac58e8f8ca56 Mon Sep 17 00:00:00 2001
From: Carl Gay <carlgay@gmail.com>
Date: Sat, 21 Sep 2024 17:29:03 -0400
Subject: [PATCH] common-dylan/timers.dylan: new function microsecond-counter

I needed some kind of low-level system counter to implement a clock() built-in
while writing the interpreter in Crafting Interpreters and common-dylan:timers
has almost the right thing and seems a natural place to add one.
---
 sources/common-dylan/library.dylan                |  3 ++-
 .../tests/common-dylan-test-suite.lid             |  1 +
 sources/common-dylan/tests/library.dylan          |  1 +
 sources/common-dylan/tests/timers-tests.dylan     | 14 ++++++++++++++
 sources/common-dylan/timers.dylan                 | 15 +++++++++++++++
 5 files changed, 33 insertions(+), 1 deletion(-)
 create mode 100644 sources/common-dylan/tests/timers-tests.dylan

diff --git a/sources/common-dylan/library.dylan b/sources/common-dylan/library.dylan
index a78ac4dca..15c9c221b 100644
--- a/sources/common-dylan/library.dylan
+++ b/sources/common-dylan/library.dylan
@@ -47,7 +47,8 @@ define module simple-timers
          timer-start,
          timer-stop,
          timer-accumulated-time,
-         timer-running?;
+         timer-running?,
+         microsecond-counter;
 end module simple-timers;
 
 define module byte-vector
diff --git a/sources/common-dylan/tests/common-dylan-test-suite.lid b/sources/common-dylan/tests/common-dylan-test-suite.lid
index 587265d5f..5ab5c4715 100644
--- a/sources/common-dylan/tests/common-dylan-test-suite.lid
+++ b/sources/common-dylan/tests/common-dylan-test-suite.lid
@@ -12,6 +12,7 @@ Files: library
        streams
        byte-vector
        machine-words
+       timers-tests
        transcendentals
        regressions
        threads/simple-locks
diff --git a/sources/common-dylan/tests/library.dylan b/sources/common-dylan/tests/library.dylan
index 44f971541..48ee72b0d 100644
--- a/sources/common-dylan/tests/library.dylan
+++ b/sources/common-dylan/tests/library.dylan
@@ -40,6 +40,7 @@ define module common-dylan-test-suite
   use simple-format;
   use simple-random;
   use simple-profiling;
+  use simple-timers;
   use file-system,
     import: { file-exists? };
   use operating-system,
diff --git a/sources/common-dylan/tests/timers-tests.dylan b/sources/common-dylan/tests/timers-tests.dylan
new file mode 100644
index 000000000..b0a135643
--- /dev/null
+++ b/sources/common-dylan/tests/timers-tests.dylan
@@ -0,0 +1,14 @@
+Module: common-dylan-test-suite
+
+
+define test test-microsecond-counter ()
+  let t1 = microsecond-counter();
+  sleep(0.1);
+  let t2 = microsecond-counter();
+  let diff = t2 - t1;
+  // I need slop to be at least 5200 on my macOS M3 Pro. Be more generous than
+  // that since the main point is simply to exercise the function at all. --cgay
+  let slop = 50_000;
+  assert-true(diff >= (100_000 - slop) & diff < (100_000 + slop),
+              diff);
+end test;
diff --git a/sources/common-dylan/timers.dylan b/sources/common-dylan/timers.dylan
index 0535bd899..78280c3aa 100644
--- a/sources/common-dylan/timers.dylan
+++ b/sources/common-dylan/timers.dylan
@@ -111,3 +111,18 @@ define inline function %timer-diff-times
     values(seconds, microseconds)
   end if
 end;
+
+// We use a microsecond counter rather than nanoseconds because implementations
+// may legitimately return a time since some arbitrary epoch rather than, say,
+// the machine uptime, and that could easily overflow given only 61 usable
+// bits. Ex: In 2024, the nanos since 1970-01-01 already uses 61 bits.
+define function microsecond-counter () => (microseconds :: <integer>)
+  let (sec :: <machine-word>, nano :: <machine-word>)
+    = %timer-current-time();
+  // I think coerce...(u%-(sec, 0)) is faster than as-unsigned(<integer>, sec)
+  // due to the latter causing a fully dynamic gf method dispatch. Is there a
+  // better way?
+  let seconds :: <integer> = coerce-machine-word-to-integer(u%-(sec, 0));
+  let microseconds :: <integer> = coerce-machine-word-to-integer(u%divide(nano, 1000));
+  seconds * 1_000_000 + microseconds
+end function;