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 POSIX (Realtime Extension) version of this package 33 34with Ada.Task_Identification; use Ada.Task_Identification; 35with Ada.Unchecked_Conversion; 36 37with System.OS_Constants; use System.OS_Constants; 38with System.OS_Interface; use System.OS_Interface; 39 40with Interfaces.C; use Interfaces.C; 41 42package body Ada.Execution_Time is 43 44 pragma Linker_Options ("-lrt"); 45 -- POSIX.1b Realtime Extensions library. Needed to have access to function 46 -- clock_gettime. 47 48 --------- 49 -- "+" -- 50 --------- 51 52 function "+" 53 (Left : CPU_Time; 54 Right : Ada.Real_Time.Time_Span) return CPU_Time 55 is 56 use type Ada.Real_Time.Time; 57 begin 58 return CPU_Time (Ada.Real_Time.Time (Left) + Right); 59 end "+"; 60 61 function "+" 62 (Left : Ada.Real_Time.Time_Span; 63 Right : CPU_Time) return CPU_Time 64 is 65 use type Ada.Real_Time.Time; 66 begin 67 return CPU_Time (Left + Ada.Real_Time.Time (Right)); 68 end "+"; 69 70 --------- 71 -- "-" -- 72 --------- 73 74 function "-" 75 (Left : CPU_Time; 76 Right : Ada.Real_Time.Time_Span) return CPU_Time 77 is 78 use type Ada.Real_Time.Time; 79 begin 80 return CPU_Time (Ada.Real_Time.Time (Left) - Right); 81 end "-"; 82 83 function "-" 84 (Left : CPU_Time; 85 Right : CPU_Time) return Ada.Real_Time.Time_Span 86 is 87 use type Ada.Real_Time.Time; 88 begin 89 return (Ada.Real_Time.Time (Left) - Ada.Real_Time.Time (Right)); 90 end "-"; 91 92 ----------- 93 -- Clock -- 94 ----------- 95 96 function Clock 97 (T : Ada.Task_Identification.Task_Id := 98 Ada.Task_Identification.Current_Task) return CPU_Time 99 is 100 TS : aliased timespec; 101 Result : Interfaces.C.int; 102 103 function To_CPU_Time is 104 new Ada.Unchecked_Conversion (Duration, CPU_Time); 105 -- Time is equal to Duration (although it is a private type) and 106 -- CPU_Time is equal to Time. 107 108 function clock_gettime 109 (clock_id : Interfaces.C.int; 110 tp : access timespec) 111 return int; 112 pragma Import (C, clock_gettime, "clock_gettime"); 113 -- Function from the POSIX.1b Realtime Extensions library 114 115 begin 116 if T = Ada.Task_Identification.Null_Task_Id then 117 raise Program_Error; 118 end if; 119 120 Result := clock_gettime 121 (clock_id => CLOCK_THREAD_CPUTIME_ID, tp => TS'Unchecked_Access); 122 pragma Assert (Result = 0); 123 124 return To_CPU_Time (To_Duration (TS)); 125 end Clock; 126 127 -------------------------- 128 -- Clock_For_Interrupts -- 129 -------------------------- 130 131 function Clock_For_Interrupts return CPU_Time is 132 begin 133 -- According to AI 0170-1, D.14(18.1/3), if Interrupt_Clocks_Supported 134 -- is set to False the function raises Program_Error. 135 136 raise Program_Error; 137 return CPU_Time_First; 138 end Clock_For_Interrupts; 139 140 ----------- 141 -- Split -- 142 ----------- 143 144 procedure Split 145 (T : CPU_Time; 146 SC : out Ada.Real_Time.Seconds_Count; 147 TS : out Ada.Real_Time.Time_Span) 148 is 149 use type Ada.Real_Time.Time; 150 begin 151 Ada.Real_Time.Split (Ada.Real_Time.Time (T), SC, TS); 152 end Split; 153 154 ------------- 155 -- Time_Of -- 156 ------------- 157 158 function Time_Of 159 (SC : Ada.Real_Time.Seconds_Count; 160 TS : Ada.Real_Time.Time_Span := Ada.Real_Time.Time_Span_Zero) 161 return CPU_Time 162 is 163 begin 164 return CPU_Time (Ada.Real_Time.Time_Of (SC, TS)); 165 end Time_Of; 166 167end Ada.Execution_Time; 168