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