Merge pull request #2 from dbuenzli/master

Pure OCaml implementation of Clock.gmtime on xen

CHANGES

@@ -1,3 +1,6 @@
+
+* xen: pure OCaml implementation of `Clock.gmtime`. 
+
 1.0.0 (07-Dec-2013):
 * Remove unnecessary cstruct dependency.
 * Install ocamlfind packages as `mirage-clock-xen` and `mirage-clock-unix`.

lib_test/xen_gmtime.ml

@@ -0,0 +1,47 @@
+(* This code can be used to test the implementation
+   of Xen's Clock.gmtime against Unix.gmtime. *)
+
+let test () =
+  let test_diff t =
+    let mine = gmtime t in
+    let unix = Unix.gmtime t in
+    let pp_diff head m u =
+      if m <> u
+      then Printf.printf "time %f differs on %s: %d <> %d\n%!" t head m u
+    in
+    pp_diff "tm_sec" mine.tm_sec unix.Unix.tm_sec;
+    pp_diff "tm_min" mine.tm_min unix.Unix.tm_min;
+    pp_diff "tm_hour" mine.tm_hour unix.Unix.tm_hour;
+    pp_diff "tm_mday" mine.tm_mday unix.Unix.tm_mday;
+    pp_diff "tm_mon" mine.tm_mon unix.Unix.tm_mon;
+    pp_diff "tm_year" mine.tm_year unix.Unix.tm_year;
+    pp_diff "tm_wday" mine.tm_wday unix.Unix.tm_wday;
+    pp_diff "tm_yday" mine.tm_yday unix.Unix.tm_yday;
+    if mine.tm_isdst <> unix.Unix.tm_isdst then
+      Printf.printf "time %f differs on isdst: %b <> %b\n%!" t
+        mine.tm_isdst unix.Unix.tm_isdst;
+    mine.tm_year
+  in
+  let seq_test () =
+    let t = ref (0.) in
+    let y = ref 0 in
+    while true do
+      let year = test_diff !t in
+      if !y <> year
+      then (y := year; Printf.printf "year: %d\n%!" (year + 1900));
+      t := !t +. 1.;
+    done
+  in
+  let rand_test () =
+    let () = Random.self_init () in
+    let about_200_years = Int64.(mul 200L (mul 365L 86_400L)) in
+    let rtime span = Int64.(sub (Random.int64 (add span one)) (div span 2L)) in
+    for i = 1 to 1_000_000_000 do
+      let ti = rtime about_200_years (* around the unix epoch *) in
+      let t = Int64.to_float ti in
+      ignore (test_diff t);
+    done
+  in
+  seq_test ();
+(*  rand_test (); *)
+  ()

xen/clock.ml

@@ -1,5 +1,6 @@
 (*
  * Copyright (c) 2010 Anil Madhavapeddy <anil@recoil.org>
+ *               2014 Daniel C. Bünzli
  *
  * Permission to use, copy, modify, and distribute this software for any
  * purpose with or without fee is hereby granted, provided that the above
@@ -27,4 +28,80 @@ type tm = {
 }
 
 external time : unit -> float = "unix_gettimeofday"
-external gmtime : float -> tm = "unix_gmtime"
+
+(* Julian day to gregorian conversions are as per calendar FAQ:
+   http://www.tondering.dk/claus/cal/julperiod.php#formula
+
+   They work for positive julian days, i.e. all date after 4800 BC.
+   BC years are represented by negative number, 10 BC is -9 and BC 1
+   is 0. *)
+
+let jd_to_greg jd =
+  let a = jd + 32044 in
+  let b = (4 * a + 3) / 146097 in
+  let c = a - ((146097 * b) / 4) in
+  let d = (4 * c + 3) / 1461 in
+  let e = c - ((1461 * d) / 4) in
+  let m = (5 * e + 2) / 153 in
+  let day = e - ((153 * m + 2) / 5) + 1 in
+  let month = m + 3 - (12 * (m / 10)) in
+  let year = 100 * b + d - 4800 + (m / 10) in
+  (year, month, day)
+
+let jd_of_greg year month day =
+  let a = (14 - month) / 12 in
+  let y = year + 4800 - a in
+  let m = month + 12 * a - 3 in
+  day + ((153 * m) + 2)/ 5 + 365 * y +
+  (y / 4) - (y / 100) + (y / 400) - 32045
+
+let jd_to_year_day jd greg_year (* of [jd] *) =
+  jd - (jd_of_greg (greg_year - 1) 12 31) (* last year's last date in jd *)
+
+let jd_to_week_day jd =
+  (* The 0 julian day was a Monday, in Unix sunday is 0 *)
+  (jd + 1) mod 7
+
+(* Decomposing a unix time stamp.
+
+   POSIX time counts seconds since the epoch 1970-01-01 00:00:00 UTC
+   without counting leap seconds (when a leap second occurs a posix
+   second can be two SI seconds or zero SI second). Hence 86_400 posix
+   seconds always represent an UTC day and the translation below is
+   completly accurate. Note that by definition a unix timestamp cannot
+   represent a leap second.
+
+   The algorithm proceeds by dividing the time stamp by 86_400 this
+   gives us the number of julian days since the epoch, with that we
+   can find the julian day and convert it to a gregorian calendar date
+   using [jd_to_greg]. The remainder of initial division is the number
+   of remaining number of seconds in that day, it defines the time.
+
+   N.B for negative unix time stamp (stricly speaking undefined on
+   gmtime) the proleptic gregorian calendar is used. *)
+
+let gmtime u =
+  let unix_epoch_julian_day = 2440588 in
+  let t = floor u in
+  let day_num, day_clock =
+    if t >= 0. then
+      let num = truncate (t /. 86_400.) in
+      let clock = truncate (mod_float t 86_400.) in
+      num, clock
+    else
+      let t = t +. 1. in
+      let num = truncate (t /. 86_400.) - 1 in
+      let clock = (86_400 + (truncate (mod_float t 86_400.))) - 1 in
+      num, clock
+  in
+  let hh = day_clock / 3600 in
+  let mm = (day_clock mod 3600) / 60 in
+  let ss = day_clock mod 60 in
+  let jd = unix_epoch_julian_day + day_num in
+  let year, month, month_day = jd_to_greg jd in
+  let week_day = jd_to_week_day jd in
+  let year_day = jd_to_year_day jd year in
+  { tm_year = year - 1900; tm_mon = month - 1; tm_mday = month_day;
+    tm_hour = hh; tm_min = mm; tm_sec = ss;
+    tm_wday = week_day; tm_yday = year_day - 1;
+    tm_isdst = false; }