1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
(*---------------------------------------------------------------------------*
IMPLEMENTATION cf_stdtime.ml
Copyright (c) 2003-2006, James H. Woodyatt
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in
the documentation and/or other materials provided with the
distribution
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
OF THE POSSIBILITY OF SUCH DAMAGE.
*---------------------------------------------------------------------------*)
type t = {
year: int; (* -2937947 .. 2941664, 1 BC = 0 *)
month: int; (* january=1 .. december=12 *)
day: int; (* 1 .. 31 *)
hour: int; (* 0 .. 23 *)
minute: int; (* 0 .. 59 *)
second: int; (* 0 .. 60, 60=leap second *)
}
let sixty_ = Int64.of_int 60
let magic58486_ = Int64.of_int 58486
let magic53375995543064_ = Int64.of_string "53375995543064"
let secs_per_day_ = Int64.of_int 86400
let utc_of_tai64 ?wday ?yday mark =
let leap, mark = Cf_tai64.leapsec_sub mark in
let u = Cf_tai64.sub mark Cf_tai64.first in
let u = Int64.add u magic58486_ in
let s = Int64.rem u secs_per_day_ in
let second =
if leap then 60 else (Int64.to_int (Int64.rem s sixty_))
in
let s = Int64.div s sixty_ in
let minute = (Int64.to_int (Int64.rem s sixty_)) in
let s = Int64.div s sixty_ in
let hour = Int64.to_int s in
let u = Int64.div u secs_per_day_ in
let u = Int64.sub u magic53375995543064_ in
let mjd = Int64.to_int u in
let year, month, day = Cf_gregorian.of_mjd ?wday ?yday mjd in {
year = year;
month = month;
day = day;
hour = hour;
minute = minute;
second = second;
}
let utc_to_tai64_unsafe ~year ~month ~day ~hour ~minute ~second =
let sec = ((((hour * 60) + minute)) * 60) + second in
let mjd = Cf_gregorian.to_mjd ~year ~month ~day in
let s64 = Int64.mul (Int64.of_int mjd) secs_per_day_ in
let s64 = Int64.add s64 (Int64.of_int sec) in
let tai = Cf_tai64.add_int64 Cf_tai64.mjd_epoch s64 in
Cf_tai64.leapsec_add tai (second = 60)
let utc_to_tai64 ~year ~month ~day ~hour ~minute ~second =
if not (Cf_gregorian.is_valid ~year ~month ~day) then
invalid_arg "Cf_stdtime.utc_to_tai64: not valid gregorian date.";
if hour < 0 || hour > 23 ||
minute < 0 || minute > 59 ||
second < 0 || second > 60 then
invalid_arg "Cf_stdtime.utc_to_tai64: not valid wallclock time.";
let sec = ((((hour * 60) + minute)) * 60) + second in
let mjd = Cf_gregorian.to_mjd ~year ~month ~day in
let s64 = Int64.mul (Int64.of_int mjd) secs_per_day_ in
let s64 = Int64.add s64 (Int64.of_int sec) in
let tai = Cf_tai64.add_int64 Cf_tai64.mjd_epoch s64 in
if second < 60 then
Cf_tai64.leapsec_add tai false
else
let v = Cf_tai64.leapsec_add tai true in
let leap, _ = Cf_tai64.leapsec_sub tai in
if not leap then
invalid_arg "Cf_stdtime.utc_to_tai64: unrecorded leap second.";
v
(*--- End of File [ cf_stdtime.ml ] ---*)
|
