otel P2: now-ns wraps host clock-milliseconds as epoch nanoseconds

Clamp against a high-water mark so the clock never steps backwards; span
durations stay non-negative. Real ns-scale timestamps replace the P1
placeholder counter.
This commit is contained in:
2026-07-01 14:24:54 +00:00
parent c8cc4a70dc
commit 51d4224a55
2 changed files with 28 additions and 6 deletions

View File

@@ -9,8 +9,7 @@
;; ── monotonic id + clock ───────────────────────────────────────────── ;; ── monotonic id + clock ─────────────────────────────────────────────
;; A simple process-monotonic counter gives collision-free ids without needing a ;; A simple process-monotonic counter gives collision-free ids without needing a
;; random source (Math.random/Date.now aren't available on this host). now-ns is a ;; random source (Math.random/Date.now aren't available on this host).
;; placeholder tick here (monotonic non-decreasing); P2 wraps the real host clock.
(define otel/-id-counter 0) (define otel/-id-counter 0)
(define otel/-next-id (define otel/-next-id
(fn (prefix) (fn (prefix)
@@ -20,12 +19,19 @@
(define otel/gen-trace-id (fn () (otel/-next-id "trace-"))) (define otel/gen-trace-id (fn () (otel/-next-id "trace-")))
(define otel/gen-span-id (fn () (otel/-next-id "span-"))) (define otel/gen-span-id (fn () (otel/-next-id "span-")))
(define otel/-clock 0) ;; now-ns — real epoch time in NANOSECONDS (the unit OTLP wants for
;; start/endTimeUnixNano). The OCaml host exposes `clock-milliseconds`
;; (Unix.gettimeofday, epoch ms); we scale by 1e6. Wall clocks can step
;; backwards (NTP), so we clamp against a high-water mark: now-ns never
;; decreases, keeping span durations non-negative even across a clock step.
(define otel/-last-ns 0)
(define otel/now-ns (define otel/now-ns
(fn () (fn ()
(begin (let ((raw (* (clock-milliseconds) 1000000)))
(set! otel/-clock (+ otel/-clock 1)) (let ((t (if (> raw otel/-last-ns) raw otel/-last-ns)))
otel/-clock))) (begin
(set! otel/-last-ns t)
t)))))
;; ── the dynamic parent stack ───────────────────────────────────────── ;; ── the dynamic parent stack ─────────────────────────────────────────
;; head = the innermost (current) span context {:span id :trace id}. Pushing on ;; head = the innermost (current) span context {:span id :trace id}. Pushing on

View File

@@ -64,6 +64,22 @@
(host-ot-test "newest kept" (get (last (otel/recent)) :span) 5) (host-ot-test "newest kept" (get (last (otel/recent)) :span) 5)
(otel/set-cap! 1000) (otel/set-cap! 1000)
;; ── P2: now-ns wraps the host monotonic clock ──────────────────────
;; now-ns is real epoch NANOSECONDS (clock-milliseconds * 1e6), clamped so it
;; never goes backwards. Non-negative, non-decreasing, nanosecond-scale.
(define host-ot-n0 (otel/now-ns))
(define host-ot-n1 (otel/now-ns))
(host-ot-test "now-ns non-negative" (>= host-ot-n0 0) true)
(host-ot-test "now-ns monotonic non-decreasing" (>= host-ot-n1 host-ot-n0) true)
(host-ot-test "now-ns is nanosecond-scale" (> host-ot-n0 1000000000000000) true)
;; a real with-span straddles the host clock
(otel/reset!)
(otel/with-span "timed" {} (fn () nil))
(define host-ot-timed (first (otel/recent)))
(host-ot-test "timed span t1 >= t0" (>= (get host-ot-timed :t1) (get host-ot-timed :t0)) true)
(host-ot-test "timed span t0 nanosecond-scale" (> (get host-ot-timed :t0) 1000000000000000) true)
(define (define
host-ot-tests-run! host-ot-tests-run!
(fn (fn