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:
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user