1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT RUN-TIME COMPONENTS                         --
4--                                                                          --
5--                   A D A . E X E C U T I O N _ T I M E                    --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--         Copyright (C) 2007-2018, Free Software Foundation, Inc.          --
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-- As a special exception under Section 7 of GPL version 3, you are granted --
19-- additional permissions described in the GCC Runtime Library Exception,   --
20-- version 3.1, as published by the Free Software Foundation.               --
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 POSIX (Realtime Extension) version of this package
33
34with Ada.Task_Identification;  use Ada.Task_Identification;
35with Ada.Unchecked_Conversion;
36
37with System.Tasking;
38with System.OS_Interface; use System.OS_Interface;
39with System.Task_Primitives.Operations; use System.Task_Primitives.Operations;
40
41with Interfaces.C; use Interfaces.C;
42
43package body Ada.Execution_Time is
44
45   pragma Linker_Options ("-lrt");
46   --  POSIX.1b Realtime Extensions library. Needed to have access to function
47   --  clock_gettime.
48
49   ---------
50   -- "+" --
51   ---------
52
53   function "+"
54     (Left  : CPU_Time;
55      Right : Ada.Real_Time.Time_Span) return CPU_Time
56   is
57      use type Ada.Real_Time.Time;
58   begin
59      return CPU_Time (Ada.Real_Time.Time (Left) + Right);
60   end "+";
61
62   function "+"
63     (Left  : Ada.Real_Time.Time_Span;
64      Right : CPU_Time) return CPU_Time
65   is
66      use type Ada.Real_Time.Time;
67   begin
68      return CPU_Time (Left + Ada.Real_Time.Time (Right));
69   end "+";
70
71   ---------
72   -- "-" --
73   ---------
74
75   function "-"
76     (Left  : CPU_Time;
77      Right : Ada.Real_Time.Time_Span) return CPU_Time
78   is
79      use type Ada.Real_Time.Time;
80   begin
81      return CPU_Time (Ada.Real_Time.Time (Left) - Right);
82   end "-";
83
84   function "-"
85     (Left  : CPU_Time;
86      Right : CPU_Time) return Ada.Real_Time.Time_Span
87   is
88      use type Ada.Real_Time.Time;
89   begin
90      return (Ada.Real_Time.Time (Left) - Ada.Real_Time.Time (Right));
91   end "-";
92
93   -----------
94   -- Clock --
95   -----------
96
97   function Clock
98     (T : Ada.Task_Identification.Task_Id :=
99        Ada.Task_Identification.Current_Task) return CPU_Time
100   is
101      TS       : aliased timespec;
102      Clock_Id : aliased Interfaces.C.int;
103      Result   : Interfaces.C.int;
104
105      function To_CPU_Time is
106        new Ada.Unchecked_Conversion (Duration, CPU_Time);
107      --  Time is equal to Duration (although it is a private type) and
108      --  CPU_Time is equal to Time.
109
110      function Convert_Ids is new
111        Ada.Unchecked_Conversion (Task_Id, System.Tasking.Task_Id);
112
113      function clock_gettime
114        (clock_id : Interfaces.C.int;
115         tp       : access timespec)
116         return int;
117      pragma Import (C, clock_gettime, "clock_gettime");
118      --  Function from the POSIX.1b Realtime Extensions library
119
120      function pthread_getcpuclockid
121        (tid       : Thread_Id;
122         clock_id  : access Interfaces.C.int)
123         return int;
124      pragma Import (C, pthread_getcpuclockid, "pthread_getcpuclockid");
125      --  Function from the Thread CPU-Time Clocks option
126
127   begin
128      if T = Ada.Task_Identification.Null_Task_Id then
129         raise Program_Error;
130      else
131         --  Get the CPU clock for the task passed as parameter
132
133         Result := pthread_getcpuclockid
134           (Get_Thread_Id (Convert_Ids (T)), Clock_Id'Access);
135         pragma Assert (Result = 0);
136      end if;
137
138      Result := clock_gettime
139        (clock_id => Clock_Id, tp => TS'Unchecked_Access);
140      pragma Assert (Result = 0);
141
142      return To_CPU_Time (To_Duration (TS));
143   end Clock;
144
145   --------------------------
146   -- Clock_For_Interrupts --
147   --------------------------
148
149   function Clock_For_Interrupts return CPU_Time is
150   begin
151      --  According to AI 0170-1, D.14(18.1/3), if Interrupt_Clocks_Supported
152      --  is set to False the function raises Program_Error.
153
154      raise Program_Error;
155      return CPU_Time_First;
156   end Clock_For_Interrupts;
157
158   -----------
159   -- Split --
160   -----------
161
162   procedure Split
163     (T  : CPU_Time;
164      SC : out Ada.Real_Time.Seconds_Count;
165      TS : out Ada.Real_Time.Time_Span)
166   is
167
168   begin
169      Ada.Real_Time.Split (Ada.Real_Time.Time (T), SC, TS);
170   end Split;
171
172   -------------
173   -- Time_Of --
174   -------------
175
176   function Time_Of
177     (SC : Ada.Real_Time.Seconds_Count;
178      TS : Ada.Real_Time.Time_Span := Ada.Real_Time.Time_Span_Zero)
179      return CPU_Time
180   is
181   begin
182      return CPU_Time (Ada.Real_Time.Time_Of (SC, TS));
183   end Time_Of;
184
185end Ada.Execution_Time;
186