File : a-exetim-posix.adb
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-2015, 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 -- --
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 POSIX (Realtime Extension) version of this package
33
34 with Ada.Task_Identification; use Ada.Task_Identification;
35 with Ada.Unchecked_Conversion;
36
37 with System.Tasking;
38 with System.OS_Interface; use System.OS_Interface;
39 with System.Task_Primitives.Operations; use System.Task_Primitives.Operations;
40
41 with Interfaces.C; use Interfaces.C;
42
43 package 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 use type Ada.Real_Time.Time;
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
185 end Ada.Execution_Time;