|
111
|
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-2017, 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 Windows native version of this package
|
|
|
33
|
|
|
34 with Ada.Task_Identification; use Ada.Task_Identification;
|
|
|
35 with Ada.Unchecked_Conversion;
|
|
|
36
|
|
|
37 with System.OS_Interface; use System.OS_Interface;
|
|
|
38 with System.Task_Primitives.Operations; use System.Task_Primitives.Operations;
|
|
|
39 with System.Tasking; use System.Tasking;
|
|
|
40 with System.Win32; use System.Win32;
|
|
|
41
|
|
|
42 package body Ada.Execution_Time with
|
|
|
43 SPARK_Mode => Off
|
|
|
44 is
|
|
|
45
|
|
|
46 ---------
|
|
|
47 -- "+" --
|
|
|
48 ---------
|
|
|
49
|
|
|
50 function "+"
|
|
|
51 (Left : CPU_Time;
|
|
|
52 Right : Ada.Real_Time.Time_Span) return CPU_Time
|
|
|
53 is
|
|
|
54 use type Ada.Real_Time.Time;
|
|
|
55 begin
|
|
|
56 return CPU_Time (Ada.Real_Time.Time (Left) + Right);
|
|
|
57 end "+";
|
|
|
58
|
|
|
59 function "+"
|
|
|
60 (Left : Ada.Real_Time.Time_Span;
|
|
|
61 Right : CPU_Time) return CPU_Time
|
|
|
62 is
|
|
|
63 use type Ada.Real_Time.Time;
|
|
|
64 begin
|
|
|
65 return CPU_Time (Left + Ada.Real_Time.Time (Right));
|
|
|
66 end "+";
|
|
|
67
|
|
|
68 ---------
|
|
|
69 -- "-" --
|
|
|
70 ---------
|
|
|
71
|
|
|
72 function "-"
|
|
|
73 (Left : CPU_Time;
|
|
|
74 Right : Ada.Real_Time.Time_Span) return CPU_Time
|
|
|
75 is
|
|
|
76 use type Ada.Real_Time.Time;
|
|
|
77 begin
|
|
|
78 return CPU_Time (Ada.Real_Time.Time (Left) - Right);
|
|
|
79 end "-";
|
|
|
80
|
|
|
81 function "-"
|
|
|
82 (Left : CPU_Time;
|
|
|
83 Right : CPU_Time) return Ada.Real_Time.Time_Span
|
|
|
84 is
|
|
|
85 use type Ada.Real_Time.Time;
|
|
|
86 begin
|
|
|
87 return (Ada.Real_Time.Time (Left) - Ada.Real_Time.Time (Right));
|
|
|
88 end "-";
|
|
|
89
|
|
|
90 -----------
|
|
|
91 -- Clock --
|
|
|
92 -----------
|
|
|
93
|
|
|
94 function Clock
|
|
|
95 (T : Ada.Task_Identification.Task_Id :=
|
|
|
96 Ada.Task_Identification.Current_Task) return CPU_Time
|
|
|
97 is
|
|
|
98 Hundreds_Nano_In_Sec : constant Long_Long_Float := 1.0E7;
|
|
|
99
|
|
|
100 function To_Time is new Ada.Unchecked_Conversion
|
|
|
101 (Duration, Ada.Real_Time.Time);
|
|
|
102
|
|
|
103 function To_Task_Id is new Ada.Unchecked_Conversion
|
|
|
104 (Ada.Task_Identification.Task_Id, System.Tasking.Task_Id);
|
|
|
105
|
|
|
106 C_Time : aliased Long_Long_Integer;
|
|
|
107 E_Time : aliased Long_Long_Integer;
|
|
|
108 K_Time : aliased Long_Long_Integer;
|
|
|
109 U_Time : aliased Long_Long_Integer;
|
|
|
110 Res : BOOL;
|
|
|
111
|
|
|
112 begin
|
|
|
113 if T = Ada.Task_Identification.Null_Task_Id then
|
|
|
114 raise Program_Error;
|
|
|
115 end if;
|
|
|
116
|
|
|
117 Res :=
|
|
|
118 GetThreadTimes
|
|
|
119 (HANDLE (Get_Thread_Id (To_Task_Id (T))),
|
|
|
120 C_Time'Access, E_Time'Access, K_Time'Access, U_Time'Access);
|
|
|
121
|
|
|
122 if Res = System.Win32.FALSE then
|
|
|
123 raise Program_Error;
|
|
|
124 end if;
|
|
|
125
|
|
|
126 return
|
|
|
127 CPU_Time
|
|
|
128 (To_Time
|
|
|
129 (Duration
|
|
|
130 ((Long_Long_Float (K_Time) / Hundreds_Nano_In_Sec)
|
|
|
131 + (Long_Long_Float (U_Time) / Hundreds_Nano_In_Sec))));
|
|
|
132 end Clock;
|
|
|
133
|
|
|
134 --------------------------
|
|
|
135 -- Clock_For_Interrupts --
|
|
|
136 --------------------------
|
|
|
137
|
|
|
138 function Clock_For_Interrupts return CPU_Time is
|
|
|
139 begin
|
|
|
140 -- According to AI 0170-1, D.14(18.1/3), if Interrupt_Clocks_Supported
|
|
|
141 -- is set to False the function raises Program_Error.
|
|
|
142
|
|
|
143 raise Program_Error;
|
|
|
144 return CPU_Time_First;
|
|
|
145 end Clock_For_Interrupts;
|
|
|
146
|
|
|
147 -----------
|
|
|
148 -- Split --
|
|
|
149 -----------
|
|
|
150
|
|
|
151 procedure Split
|
|
|
152 (T : CPU_Time;
|
|
|
153 SC : out Ada.Real_Time.Seconds_Count;
|
|
|
154 TS : out Ada.Real_Time.Time_Span)
|
|
|
155 is
|
|
|
156 begin
|
|
|
157 Ada.Real_Time.Split (Ada.Real_Time.Time (T), SC, TS);
|
|
|
158 end Split;
|
|
|
159
|
|
|
160 -------------
|
|
|
161 -- Time_Of --
|
|
|
162 -------------
|
|
|
163
|
|
|
164 function Time_Of
|
|
|
165 (SC : Ada.Real_Time.Seconds_Count;
|
|
|
166 TS : Ada.Real_Time.Time_Span := Ada.Real_Time.Time_Span_Zero)
|
|
|
167 return CPU_Time
|
|
|
168 is
|
|
|
169 begin
|
|
|
170 return CPU_Time (Ada.Real_Time.Time_Of (SC, TS));
|
|
|
171 end Time_Of;
|
|
|
172
|
|
|
173 end Ada.Execution_Time;
|
