gcc/ada/a-exetim-mingw.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-2008, 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 2,  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.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- As a special exception,  if other files  instantiate  generics from this --
  23 -- unit, or you link  this unit with other files  to produce an executable, --
  24 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  25 -- covered  by the  GNU  General  Public  License.  This exception does not --
  26 -- however invalidate  any other reasons why  the executable file  might be --
  27 -- covered by the  GNU Public License.                                      --
  28 --                                                                          --
  29 -- GNAT was originally developed  by the GNAT team at  New York University. --
  30 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  31 --                                                                          --
  32 ------------------------------------------------------------------------------
  33
  34 --  This is the Windows native version of this package
  35
  36 with Ada.Task_Identification;           use Ada.Task_Identification;
  37 with Ada.Unchecked_Conversion;
  38
  39 with System.OS_Interface;               use System.OS_Interface;
  40 with System.Task_Primitives.Operations; use System.Task_Primitives.Operations;
  41 with System.Tasking;                    use System.Tasking;
  42 with System.Win32;                      use System.Win32;
  43
  44 package body Ada.Execution_Time 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    -- Split --
 136    -----------
 137
 138    procedure Split
 139      (T  : CPU_Time;
 140       SC : out Ada.Real_Time.Seconds_Count;
 141       TS : out Ada.Real_Time.Time_Span)
 142    is
 143       use type Ada.Real_Time.Time;
 144    begin
 145       Ada.Real_Time.Split (Ada.Real_Time.Time (T), SC, TS);
 146    end Split;
 147
 148    -------------
 149    -- Time_Of --
 150    -------------
 151
 152    function Time_Of
 153      (SC : Ada.Real_Time.Seconds_Count;
 154       TS : Ada.Real_Time.Time_Span := Ada.Real_Time.Time_Span_Zero)
 155       return CPU_Time
 156    is
 157    begin
 158       return CPU_Time (Ada.Real_Time.Time_Of (SC, TS));
 159    end Time_Of;
 160
 161 end Ada.Execution_Time;