osc-time.lisp

@@ -0,0 +1,75 @@
+(in-package #:osc)
+
+(defconstant +unix-epoch+ (encode-universal-time 0 0 0 1 1 1970 0))
+(defconstant +2^32+ (expt 2 32))
+(defconstant +2^32/million+ (/ +2^32+ (expt 10 6)))
+(defconstant +usecs+ (expt 10 6))
+
+(deftype timetag () '(unsigned-byte 64))
+
+(defun timetagp (object)
+  (typep object 'timetag))
+
+(defun unix-secs+usecs->timetag (secs usecs)
+    (let ((sec-offset (+ secs +unix-epoch+))) ; Seconds from 1900.
+      (setf sec-offset (ash sec-offset 32))   ; Make seconds the top
+					      ; 32 bits.
+      (let ((usec-offset
+	     (round (* usecs +2^32/MILLION+))))	; Fractional part.
+	(the timetag (+ sec-offset usec-offset)))))
+
+(defun get-current-timetag ()
+  "Returns a fixed-point 64 bit NTP-style timetag, where the top
+  32 bits represent seconds since midnight 19000101, and the bottom 32
+  bits represent the fractional parts of a second."
+  (multiple-value-bind (secs usecs)
+      (sb-ext:get-time-of-day)
+    (the timetag (unix-secs+usecs->timetag secs usecs))))
+
+(defun timetag+ (original seconds-offset)
+  (declare (type timetag original))
+  (let ((offset (round (* seconds-offset +2^32+))))
+    (the timetag (+ original offset))))
+
+
+;;;=====================================================================
+;;; Functions for using double-float unix timestamps.
+;;;=====================================================================
+
+(defun get-unix-time ()
+  "Returns a a double-float representing real-time now in seconds,
+with microsecond precision, relative to 19700101."
+  (multiple-value-bind (secs usecs)
+      (sb-ext:get-time-of-day)
+    (the double-float (+ secs (microseconds->subsecs usecs)))))
+
+(defun unix-time->timetag (unix-time)
+  (multiple-value-bind (secs subsecs)
+      (floor unix-time)
+    (the timetag
+      (unix-secs+usecs->timetag secs
+				(subsecs->microseconds subsecs)))))
+
+(defun timetag->unix-time (timetag)
+  (let* ((secs (ash timetag -32))
+	 (subsec-int32 (- timetag (ash secs 32))))
+    (the double-float (+ (- secs +unix-epoch+)
+			 (int32->subsecs subsec-int32)))))
+
+(defun microseconds->subsecs (usecs)
+  (declare (type (integer 0 1000000) usecs))
+  (coerce (/ usecs  +usecs+) 'double-float))
+
+(defun subsecs->microseconds (subsecs)
+  (declare (type (float 0 1) subsecs))
+  (round (* subsecs +usecs+)))
+
+(defun int32->subsecs (int32)
+  "This maps a 32 bit integer, representing subsecond time, to a
+double float in the range 0-1."
+  (declare (type (unsigned-byte 32) int32))
+  (coerce (/ int32 +2^32+) 'double-float))
+
+(defun print-as-double (time)
+  (format t "~%~F" (coerce time 'double-float))
+  time)