OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [a-exetim-posix.adb] - Blame information for rev 801

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
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-2011, 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
 
34
with Ada.Task_Identification;  use Ada.Task_Identification;
35
with Ada.Unchecked_Conversion;
36
 
37
with System.OS_Constants; use System.OS_Constants;
38
with System.OS_Interface; use System.OS_Interface;
39
 
40
with Interfaces.C; use Interfaces.C;
41
 
42
package 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)
99
      return CPU_Time
100
   is
101
      TS     : aliased timespec;
102
      Result : Interfaces.C.int;
103
 
104
      function To_CPU_Time is
105
        new Ada.Unchecked_Conversion (Duration, CPU_Time);
106
      --  Time is equal to Duration (although it is a private type) and
107
      --  CPU_Time is equal to Time.
108
 
109
      function clock_gettime
110
        (clock_id : Interfaces.C.int;
111
         tp       : access timespec)
112
         return int;
113
      pragma Import (C, clock_gettime, "clock_gettime");
114
      --  Function from the POSIX.1b Realtime Extensions library
115
 
116
   begin
117
      if T = Ada.Task_Identification.Null_Task_Id then
118
         raise Program_Error;
119
      end if;
120
 
121
      Result := clock_gettime
122
        (clock_id => CLOCK_THREAD_CPUTIME_ID, tp => TS'Unchecked_Access);
123
      pragma Assert (Result = 0);
124
 
125
      return To_CPU_Time (To_Duration (TS));
126
   end Clock;
127
 
128
   --------------------------
129
   -- Clock_For_Interrupts --
130
   --------------------------
131
 
132
   function Clock_For_Interrupts return CPU_Time is
133
   begin
134
      --  According to AI 0170-1, D.14(18.1/3), if Interrupt_Clocks_Supported
135
      --  is set to False the function raises Program_Error.
136
 
137
      raise Program_Error;
138
      return CPU_Time_First;
139
   end Clock_For_Interrupts;
140
 
141
   -----------
142
   -- Split --
143
   -----------
144
 
145
   procedure Split
146
     (T  : CPU_Time;
147
      SC : out Ada.Real_Time.Seconds_Count;
148
      TS : out Ada.Real_Time.Time_Span)
149
   is
150
      use type Ada.Real_Time.Time;
151
   begin
152
      Ada.Real_Time.Split (Ada.Real_Time.Time (T), SC, TS);
153
   end Split;
154
 
155
   -------------
156
   -- Time_Of --
157
   -------------
158
 
159
   function Time_Of
160
     (SC : Ada.Real_Time.Seconds_Count;
161
      TS : Ada.Real_Time.Time_Span := Ada.Real_Time.Time_Span_Zero)
162
      return CPU_Time
163
   is
164
   begin
165
      return CPU_Time (Ada.Real_Time.Time_Of (SC, TS));
166
   end Time_Of;
167
 
168
end Ada.Execution_Time;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.