File : a-calclo-lynxos178-cert.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
4 -- --
5 -- A D A . C A L E N D A R . C L O C K --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2012-2014, AdaCore --
10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
17 -- --
18 -- --
19 -- --
20 -- --
21 -- --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
26 -- --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
29 -- --
30 ------------------------------------------------------------------------------
31
32 -- This is the LynxOS-178 Level A cert version of this function
33
34 with System;
35
36 separate (Ada.Calendar)
37
38 -----------
39 -- Clock --
40 -----------
41
42 function Clock return Time is
43
44 type timeval is array (1 .. 3) of Long_Integer;
45 -- The timeval array is sized to contain Long_Long_Integer sec and
46 -- Long_Integer usec. If Long_Long_Integer'Size = Long_Integer'Size then it
47 -- will be overly large but that will not effect the implementation since
48 -- it is not accessed directly.
49
50 function gettimeofday
51 (Tv : access timeval;
52 Tz : System.Address := System.Null_Address) return Integer;
53 pragma Import (C, gettimeofday, "gettimeofday");
54
55 procedure timeval_to_duration
56 (T : not null access timeval;
57 sec : not null access Long_Long_Integer;
58 usec : not null access Long_Integer);
59 pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration");
60
61 Elapsed_Seconds : Duration;
62 Elapsed_Days : Time;
63 Micro : constant := 10**6;
64 Result : Integer;
65 sec : aliased Long_Long_Integer;
66 TV : aliased timeval;
67 usec : aliased Long_Integer;
68 pragma Unreferenced (Result);
69
70 begin
71 -- The return codes for gettimeofday are as follows (from man pages):
72 -- EPERM settimeofday is called by someone other than the superuser
73 -- EINVAL Timezone (or something else) is invalid
74 -- EFAULT One of tv or tz pointed outside accessible address space
75
76 -- None of these codes signal a potential clock skew, hence the return
77 -- value is never checked.
78
79 Result := gettimeofday (TV'Access, System.Null_Address);
80 timeval_to_duration (TV'Access, sec'Access, usec'Access);
81 Elapsed_Seconds := Duration (sec) + Duration (usec) / Micro;
82 Elapsed_Days := Elapsed_Seconds / Secs_Per_Day;
83 return Radix_Time + Elapsed_Days;
84 end Clock;