1 ------------------------------------------------------------------------------
3 -- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
5 -- A D A . R E A L _ T I M E --
9 -- Copyright (C) 1991-1994, Florida State University --
10 -- Copyright (C) 1995-2003, Ada Core Technologies --
12 -- GNARL is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNARL; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- GNARL was developed by the GNARL team at Florida State University. --
31 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
33 ------------------------------------------------------------------------------
35 with System.Task_Primitives.Operations;
36 -- used for Monotonic_Clock
38 package body Ada.Real_Time is
44 -- Note that Constraint_Error may be propagated
46 function "*" (Left : Time_Span; Right : Integer) return Time_Span is
47 pragma Unsuppress (Overflow_Check);
49 return Time_Span (Duration (Left) * Right);
52 function "*" (Left : Integer; Right : Time_Span) return Time_Span is
53 pragma Unsuppress (Overflow_Check);
55 return Time_Span (Left * Duration (Right));
62 -- Note that Constraint_Error may be propagated
64 function "+" (Left : Time; Right : Time_Span) return Time is
65 pragma Unsuppress (Overflow_Check);
67 return Time (Duration (Left) + Duration (Right));
70 function "+" (Left : Time_Span; Right : Time) return Time is
71 pragma Unsuppress (Overflow_Check);
73 return Time (Duration (Left) + Duration (Right));
76 function "+" (Left, Right : Time_Span) return Time_Span is
77 pragma Unsuppress (Overflow_Check);
79 return Time_Span (Duration (Left) + Duration (Right));
86 -- Note that Constraint_Error may be propagated
88 function "-" (Left : Time; Right : Time_Span) return Time is
89 pragma Unsuppress (Overflow_Check);
91 return Time (Duration (Left) - Duration (Right));
94 function "-" (Left, Right : Time) return Time_Span is
95 pragma Unsuppress (Overflow_Check);
97 return Time_Span (Duration (Left) - Duration (Right));
100 function "-" (Left, Right : Time_Span) return Time_Span is
101 pragma Unsuppress (Overflow_Check);
103 return Time_Span (Duration (Left) - Duration (Right));
106 function "-" (Right : Time_Span) return Time_Span is
107 pragma Unsuppress (Overflow_Check);
109 return Time_Span_Zero - Right;
116 -- Note that Constraint_Error may be propagated
118 function "/" (Left, Right : Time_Span) return Integer is
119 pragma Unsuppress (Overflow_Check);
121 return Integer (Duration (Left) / Duration (Right));
124 function "/" (Left : Time_Span; Right : Integer) return Time_Span is
125 pragma Unsuppress (Overflow_Check);
127 return Time_Span (Duration (Left) / Right);
134 function Clock return Time is
136 return Time (System.Task_Primitives.Operations.Monotonic_Clock);
143 function Microseconds (US : Integer) return Time_Span is
145 return Time_Span_Unit * US * 1_000;
152 function Milliseconds (MS : Integer) return Time_Span is
154 return Time_Span_Unit * MS * 1_000_000;
161 function Nanoseconds (NS : Integer) return Time_Span is
163 return Time_Span_Unit * NS;
170 procedure Split (T : Time; SC : out Seconds_Count; TS : out Time_Span) is
174 -- Special-case for Time_First, whose absolute value is anomalous,
175 -- courtesy of two's complement.
177 if T = Time_First then
178 T_Val := abs (Time_Last);
183 -- Extract the integer part of T, truncating towards zero.
188 SC := Seconds_Count (Time_Span'(T_Val - 0.5));
195 -- If original time is negative, need to truncate towards negative
196 -- infinity, to make TS non-negative, as per ARM.
198 if Time (SC) > T then
202 TS := Time_Span (Duration (T) - Duration (SC));
209 function Time_Of (SC : Seconds_Count; TS : Time_Span) return Time is
211 return Time (SC) + TS;
218 function To_Duration (TS : Time_Span) return Duration is
220 return Duration (TS);
227 function To_Time_Span (D : Duration) return Time_Span is
229 return Time_Span (D);