1 ------------------------------------------------------------------------------
3 -- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
5 -- A D A . R E A L _ T I M E --
11 -- Copyright (C) 1991-2001, Florida State University --
13 -- GNARL is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNARL; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- As a special exception, if other files instantiate generics from this --
25 -- unit, or you link this unit with other files to produce an executable, --
26 -- this unit does not by itself cause the resulting executable to be --
27 -- covered by the GNU General Public License. This exception does not --
28 -- however invalidate any other reasons why the executable file might be --
29 -- covered by the GNU Public License. --
31 -- GNARL was developed by the GNARL team at Florida State University. It is --
32 -- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
33 -- State University (http://www.gnat.com). --
35 ------------------------------------------------------------------------------
37 with System
.Task_Primitives
.Operations
;
38 -- used for Monotonic_Clock
40 package body Ada
.Real_Time
is
46 -- Note that Constraint_Error may be propagated
48 function "*" (Left
: Time_Span
; Right
: Integer) return Time_Span
is
50 return Time_Span
(Duration (Left
) * Right
);
53 function "*" (Left
: Integer; Right
: Time_Span
) return Time_Span
is
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
66 return Time
(Duration (Left
) + Duration (Right
));
69 function "+" (Left
: Time_Span
; Right
: Time
) return Time
is
71 return Time
(Duration (Left
) + Duration (Right
));
74 function "+" (Left
, Right
: Time_Span
) return Time_Span
is
76 return Time_Span
(Duration (Left
) + Duration (Right
));
83 -- Note that Constraint_Error may be propagated
85 function "-" (Left
: Time
; Right
: Time_Span
) return Time
is
87 return Time
(Duration (Left
) - Duration (Right
));
90 function "-" (Left
, Right
: Time
) return Time_Span
is
92 return Time_Span
(Duration (Left
) - Duration (Right
));
95 function "-" (Left
, Right
: Time_Span
) return Time_Span
is
97 return Time_Span
(Duration (Left
) - Duration (Right
));
100 function "-" (Right
: Time_Span
) return Time_Span
is
102 return Time_Span_Zero
- Right
;
109 -- Note that Constraint_Error may be propagated
111 function "/" (Left
, Right
: Time_Span
) return Integer is
113 return Integer (Duration (Left
) / Duration (Right
));
116 function "/" (Left
: Time_Span
; Right
: Integer) return Time_Span
is
118 return Time_Span
(Duration (Left
) / Right
);
125 function Clock
return Time
is
127 return Time
(System
.Task_Primitives
.Operations
.Monotonic_Clock
);
134 function Microseconds
(US
: Integer) return Time_Span
is
136 return Time_Span_Unit
* US
* 1_000
;
143 function Milliseconds
(MS
: Integer) return Time_Span
is
145 return Time_Span_Unit
* MS
* 1_000_000
;
152 function Nanoseconds
(NS
: Integer) return Time_Span
is
154 return Time_Span_Unit
* NS
;
161 procedure Split
(T
: Time
; SC
: out Seconds_Count
; TS
: out Time_Span
) is
165 -- Special-case for Time_First, whose absolute value is anomalous,
166 -- courtesy of two's complement.
168 if T
= Time_First
then
169 T_Val
:= abs (Time_Last
);
174 -- Extract the integer part of T, truncating towards zero.
180 SC
:= Seconds_Count
(Time_Span
' (T_Val - 0.5));
187 -- If original time is negative, need to truncate towards negative
188 -- infinity, to make TS non-negative, as per ARM.
190 if Time (SC) > T then
201 function Time_Of (SC : Seconds_Count; TS : Time_Span) return Time is
203 return Time (SC) + TS;
210 function To_Duration (TS : Time_Span) return Duration is
212 return Duration (TS);
219 function To_Time_Span (D : Duration) return Time_Span is
221 return Time_Span (D);